From 834c57466fd1b2f4b6cb9eeeeb2baa68a9ea851b Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Mon, 25 Nov 2019 23:09:49 -0700 Subject: [PATCH] add operator exports to module declarations, treat them separately from predicate exports (#230)" --- src/prolog/forms.rs | 27 ++++-- src/prolog/lib/atts.pl | 13 ++- src/prolog/lib/builtins.pl | 58 ++++++------ src/prolog/lib/clpb.pl | 8 +- src/prolog/lib/dcgs.pl | 3 +- src/prolog/machine/compile.rs | 43 ++++++--- src/prolog/machine/mod.rs | 87 ++++++++++++----- src/prolog/machine/modules.rs | 165 ++++++++++++++++++++------------- src/prolog/machine/toplevel.rs | 61 +++++++++--- src/prolog/toplevel.pl | 25 ++++- 10 files changed, 316 insertions(+), 174 deletions(-) diff --git a/src/prolog/forms.rs b/src/prolog/forms.rs index c2e4ac14..aa8eeec6 100644 --- a/src/prolog/forms.rs +++ b/src/prolog/forms.rs @@ -179,7 +179,7 @@ pub enum Declaration { NonCountedBacktracking(ClauseName, usize), // name, arity Op(OpDecl), UseModule(ModuleSource), - UseQualifiedModule(ModuleSource, Vec), + UseQualifiedModule(ModuleSource, Vec), } impl Declaration { @@ -216,15 +216,20 @@ impl OpDecl { self.insert_into_op_dir(clause_name!(""), op_dir, 0); } - fn insert_into_op_dir(&self, module: ClauseName, op_dir: &mut OpDir, prec: usize) { - let (spec, name) = (self.1, self.2.clone()); - - let fixity = match spec { + #[inline] + pub fn fixity(&self) -> Fixity { + match self.1 { XFY | XFX | YFX => Fixity::In, XF | YF => Fixity::Post, FX | FY => Fixity::Pre, - _ => return, - }; + _ => unreachable!() + } + } + + pub fn insert_into_op_dir(&self, module: ClauseName, op_dir: &mut OpDir, prec: usize) { + let (spec, name) = (self.1, self.2.clone()); + + let fixity = self.fixity(); match op_dir.get(&(name.clone(), fixity)) { Some(cell) => { @@ -322,10 +327,16 @@ pub fn fetch_op_spec( pub type ModuleDir = IndexMap; +#[derive(Clone, PartialEq)] +pub enum ModuleExport { + OpDecl(OpDecl), + PredicateKey(PredicateKey), +} + #[derive(Clone)] pub struct ModuleDecl { pub name: ClauseName, - pub exports: Vec, + pub exports: Vec, } pub struct Module { diff --git a/src/prolog/lib/atts.pl b/src/prolog/lib/atts.pl index 5de6d32c..3fc36974 100644 --- a/src/prolog/lib/atts.pl +++ b/src/prolog/lib/atts.pl @@ -1,14 +1,13 @@ -:- module(atts, [attribute/1, call_residue_vars/2, '$absent_attr'/2, - '$copy_attr_list'/2, '$get_attr'/2, '$put_attr'/2, - '$absent_from_list'/2, '$get_from_list'/3, - '$add_to_list'/3, '$del_attr'/3, '$del_attr_step'/3, - '$del_attr_buried'/4, '$default_attr_list'/4]). +:- module(atts, [op(1199, fx, attribute), call_residue_vars/2, + '$absent_attr'/2, '$copy_attr_list'/2, '$get_attr'/2, + '$put_attr'/2, '$absent_from_list'/2, + '$get_from_list'/3, '$add_to_list'/3, '$del_attr'/3, + '$del_attr_step'/3, '$del_attr_buried'/4, + '$default_attr_list'/4]). :- use_module(library(dcgs)). :- use_module(library(terms)). -:- op(1199, fx, attribute). - /* represent the list of attributes belonging to a variable, of a particular module, as a list of terms of the form Module:put_atts(V, ListOfAtts). */ diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 8c018fcb..e6e0d40f 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -1,35 +1,19 @@ :- op(400, yfx, /). -/* 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). - -:- module(builtins, [(=)/2, (\=)/2, (\+)/1, (^)/2, (\)/1, (+)/1, - (+)/2, (**)/2, (*)/2, (-)/1, (-)/2, (/)/2, (/\)/2, (\/)/2, - (is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2, (>>)/2, - (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>=)/2, - (=<)/2, (',')/2, (->)/2, (;)/2, (=..)/2, (==)/2, (\==)/2, - (@=<)/2, (@>=)/2, (@<)/2, (@>)/2, (:)/2, abolish/1, asserta/1, - assertz/1, atom_chars/2, atom_codes/2, atom_concat/3, - atom_length/2, bagof/3, catch/3, char_code/2, clause/2, - current_op/3, current_predicate/1, current_prolog_flag/2, - expand_goal/2, expand_term/2, fail/0, false/0, findall/3, - findall/4, get_char/1, halt/0, number_chars/2, number_codes/2, - once/1, op/3, read_term/2, repeat/0, retract/1, - set_prolog_flag/2, setof/3, sub_atom/5, subsumes_term/2, - term_variables/2, throw/1, true/0, unify_with_occurs_check/2, - write/1, write_canonical/1, write_term/2, writeq/1]). - % module resolution operator. :- op(600, xfy, :). user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :- - expand_op_list([Op | OtherOps], Pred, Spec, OpResults). + '$expand_op_list'([Op | OtherOps], Pred, Spec, OpResults). + +'$expand_op_list'([], _, _, []). +'$expand_op_list'([Op | OtherOps], Pred, Spec, [(:- op(Pred, Spec, Op)) | OtherResults]) :- + '$expand_op_list'(OtherOps, Pred, Spec, OtherResults). -expand_op_list([], _, _, []). -expand_op_list([Op | OtherOps], Pred, Spec, [(:- op(Pred, Spec, Op)) | OtherResults]) :- - expand_op_list(OtherOps, Pred, Spec, OtherResults). +/* 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). @@ -37,8 +21,7 @@ expand_op_list([Op | OtherOps], Pred, Spec, [(:- op(Pred, Spec, Op)) | OtherResu :- op(400, yfx, *). :- op(200, xfy, [**, ^]). :- op(500, yfx, [/\, \/, xor]). -:- op(400, yfx, [div, //, rdiv]). -:- op(400, yfx, [<<, >>, mod, rem]). +:- op(400, yfx, [div, //, rdiv, <<, >>, mod, rem]). :- op(200, fy, [+, -, \]). % arithmetic comparison operators. @@ -47,9 +30,6 @@ expand_op_list([Op | OtherOps], Pred, Spec, [(:- op(Pred, Spec, Op)) | OtherResu % term comparison. :- op(700, xfx, [==, \==, @=<, @>=, @<, @>]). -% the maximum arity flag. needs to be replaced with current_prolog_flag(max_arity, MAX_ARITY). -max_arity(255). - % conditional operators. :- op(1050, xfy, ->). :- op(1100, xfy, ;). @@ -58,6 +38,24 @@ max_arity(255). :- op(700, xfx, [=, =.., \=]). :- op(900, fy, \+). +:- module(builtins, [(=)/2, (\=)/2, (\+)/1, (',')/2, (->)/2, (;)/2, + (=..)/2, (:)/2, abolish/1, asserta/1, assertz/1, + atom_chars/2, atom_codes/2, atom_concat/3, + atom_length/2, bagof/3, catch/3, char_code/2, + clause/2, current_op/3, current_predicate/1, + current_prolog_flag/2, expand_goal/2, + expand_term/2, fail/0, false/0, findall/3, + findall/4, get_char/1, halt/0, max_arity/1, + number_chars/2, number_codes/2, once/1, op/3, + read_term/2, repeat/0, retract/1, + set_prolog_flag/2, setof/3, sub_atom/5, + subsumes_term/2, term_variables/2, throw/1, + true/0, unify_with_occurs_check/2, write/1, + write_canonical/1, write_term/2, writeq/1]). + +% the maximum arity flag. needs to be replaced with current_prolog_flag(max_arity, MAX_ARITY). +max_arity(255). + % unify. X = X. diff --git a/src/prolog/lib/clpb.pl b/src/prolog/lib/clpb.pl index 5aa9561a..d11c5a42 100644 --- a/src/prolog/lib/clpb.pl +++ b/src/prolog/lib/clpb.pl @@ -16,11 +16,9 @@ Public operators. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -:- op(300, fy, ~). -:- op(500, yfx, #). - -:- module(clpb, [ - sat/1, +:- module(clpb, [op(300, fy, ~), + op(500, yfx, #), + sat/1, taut/2, labeling/1, sat_count/2, diff --git a/src/prolog/lib/dcgs.pl b/src/prolog/lib/dcgs.pl index 1d69b68c..2ee8baac 100644 --- a/src/prolog/lib/dcgs.pl +++ b/src/prolog/lib/dcgs.pl @@ -1,7 +1,6 @@ -:- op(1200, xfx, -->). % :- op(1105, xfy, ('|')). -:- module(dcgs, [phrase/2, phrase/3]). +:- module(dcgs, [op(1200, xfx, -->), phrase/2, phrase/3]). :- use_module(library(lists), [append/3]). diff --git a/src/prolog/machine/compile.rs b/src/prolog/machine/compile.rs index b24584df..36c7bf60 100644 --- a/src/prolog/machine/compile.rs +++ b/src/prolog/machine/compile.rs @@ -574,7 +574,7 @@ impl ListingCompiler { submodule: ClauseName, code_repo: &mut CodeRepo, flags: MachineFlags, - exports: &Vec, + exports: &Vec, wam_indices: &mut IndexStore, indices: &mut IndexStore, ) -> Result<(), SessionError> { @@ -712,6 +712,24 @@ impl ListingCompiler { (len, queue_len) } + fn submit_op( + &mut self, + wam: &Machine, + indices: &mut IndexStore, + op_decl: &OpDecl, + ) -> Result<(), SessionError> { + let spec = get_desc( + op_decl.name(), + composite_op!( + self.module.is_some(), + &wam.indices.op_dir, + &mut indices.op_dir + ), + ); + + op_decl.submit(self.get_module_name(), spec, &mut indices.op_dir) + } + fn process_decl( &mut self, decl: Declaration, @@ -730,6 +748,7 @@ impl ListingCompiler { .code_repo .compile_hook(hook, flags) .map_err(SessionError::from); + wam.code_repo.truncate_terms(key, len, queue_len); result @@ -738,16 +757,7 @@ impl ListingCompiler { Ok(self.add_non_counted_bt_flag(name, arity)) } Declaration::Op(op_decl) => { - let spec = get_desc( - op_decl.name(), - composite_op!( - self.module.is_some(), - &wam.indices.op_dir, - &mut indices.op_dir - ), - ); - - op_decl.submit(self.get_module_name(), spec, &mut indices.op_dir) + self.submit_op(wam, indices, &op_decl) } Declaration::UseModule(ModuleSource::Library(name)) => { let name = if !wam.indices.modules.contains_key(&name) { @@ -779,6 +789,12 @@ impl ListingCompiler { let module_name = module_decl.name.clone(); let atom_tbl = TabledData::new(module_name.to_rc()); + for export in module_decl.exports.iter() { + if let ModuleExport::OpDecl(ref op_decl) = export { + self.submit_op(wam, indices, op_decl)?; + } + } + Ok(self.module = Some(Module::new(module_decl, atom_tbl))) } else { Err(SessionError::from(ParserError::InvalidModuleDecl)) @@ -959,8 +975,9 @@ fn compile_work_impl( if let Some(mut module) = compiler.module.take() { if module.is_impromptu_module { module.module_decl.exports = indices.code_dir.keys().cloned() - .filter(|(name, _)| name.owning_module().as_str() != "builtins") - .collect(); + .filter(|(name, _)| name.owning_module().as_str() != "builtins") + .map(ModuleExport::PredicateKey) + .collect(); } let mut clause_code_generator = diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index 527a2301..a562858c 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -34,6 +34,7 @@ use crate::prolog::machine::machine_errors::*; use crate::prolog::machine::machine_indices::*; use crate::prolog::machine::machine_state::*; use crate::prolog::machine::modules::*; +use crate::prolog::machine::toplevel::*; use crate::prolog::read::PrologStream; use indexmap::IndexMap; @@ -139,7 +140,7 @@ impl SubModuleUser for IndexStore { code_repo: &mut CodeRepo, flags: MachineFlags, submodule: &Module, - exports: &Vec, + exports: &Vec, ) -> Result<(), SessionError> { use_qualified_module(self, submodule, exports)?; submodule @@ -400,30 +401,64 @@ impl Machine { return; } - fn extract_predicate_indicator_list(&mut self) -> Vec + fn extract_module_export_list(&mut self) -> Result, ParserError> { - let export_list = self.machine_st[temp_v!(2)].clone(); - let mut export_list = self.machine_st.store(self.machine_st.deref(export_list)); + let mut export_list = self.machine_st[temp_v!(2)].clone(); let mut exports = vec![]; - while let Addr::Lis(l) = export_list { + while let Addr::Lis(l) = self.machine_st.store(self.machine_st.deref(export_list)) { match &self.machine_st.heap[l] { &HeapCellValue::Addr(Addr::Str(s)) => { - let name = match &self.machine_st.heap[s+1] { - &HeapCellValue::Addr(Addr::Con(Constant::Atom(ref name, _))) => - name.clone(), - _ => - unreachable!() - }; - - let arity = match &self.machine_st.heap[s+2] { - &HeapCellValue::Addr(Addr::Con(Constant::Integer(ref arity))) => - arity.to_usize().unwrap(), - _ => - unreachable!() - }; - - exports.push((name, arity)); + match &self.machine_st.heap[s] { + HeapCellValue::NamedStr(arity, ref name, _) + if *arity == 2 && name.as_str() == "/" => { + let name = match &self.machine_st.heap[s+1] { + &HeapCellValue::Addr(Addr::Con(Constant::Atom(ref name, _))) => + name.clone(), + _ => + unreachable!() + }; + + let arity = match &self.machine_st.heap[s+2] { + &HeapCellValue::Addr(Addr::Con(Constant::Integer(ref arity))) => + arity.to_usize().unwrap(), + _ => + unreachable!() + }; + + exports.push(ModuleExport::PredicateKey((name, arity))); + } + HeapCellValue::NamedStr(arity, ref name, _) + if *arity == 3 && name.as_str() == "op" => { + let name = match &self.machine_st.heap[s+3] { + &HeapCellValue::Addr(Addr::Con(Constant::Atom(ref name, _))) => + name.clone(), + _ => + unreachable!() + }; + + let spec = match &self.machine_st.heap[s+2] { + &HeapCellValue::Addr(Addr::Con(Constant::Atom(ref name, _))) => + name.clone(), + _ => + unreachable!() + }; + + let prec = match &self.machine_st.heap[s+1] { + &HeapCellValue::Addr(Addr::Con(Constant::Integer(ref arity))) => + arity.to_usize().unwrap(), + _ => + unreachable!() + }; + + exports.push(ModuleExport::OpDecl(to_op_decl( + prec, + spec.as_str(), + name, + )?)); + } + _ => unreachable!() + } } _ => unreachable!() } @@ -431,7 +466,7 @@ impl Machine { export_list = self.machine_st.heap[l+1].as_addr(l+1); } - exports + Ok(exports) } fn use_module(&mut self, to_src: ToSource) @@ -489,7 +524,13 @@ impl Machine { _ => unreachable!() }; - let exports = self.extract_predicate_indicator_list(); + let exports = match self.extract_module_export_list() { + Ok(exports) => exports, + Err(e) => { + self.throw_session_error(SessionError::from(e), (clause_name!("use_module"), 2)); + return; + } + }; let load_result = match to_src(name) { ModuleSource::Library(name) => @@ -521,7 +562,7 @@ impl Machine { self.code_repo.cached_query = cached_query; if let Err(e) = result { - self.throw_session_error(e, (clause_name!("use_module"), 1)); + self.throw_session_error(e, (clause_name!("use_module"), 2)); } } diff --git a/src/prolog/machine/modules.rs b/src/prolog/machine/modules.rs index b6c07e8f..508eb77d 100644 --- a/src/prolog/machine/modules.rs +++ b/src/prolog/machine/modules.rs @@ -137,64 +137,55 @@ pub trait SubModuleUser { } fn remove_module(&mut self, mod_name: ClauseName, module: &Module) { - for (name, arity) in module.module_decl.exports.iter().cloned() { - let name = name.defrock_brackets(); - - match self.get_code_index((name.clone(), arity), mod_name.clone()) { - Some(CodeIndex(ref code_idx)) => { - if &code_idx.borrow().1 != &module.module_decl.name { - continue; - } - - self.remove_code_index((name.clone(), arity)); - - // remove or respecify ops. - if arity == 2 { - if let Some(mod_name) = self.get_op_module_name(name.clone(), Fixity::In) { - if mod_name == module.module_decl.name { - self.op_dir().remove(&(name.clone(), Fixity::In)); + for export in module.module_decl.exports.iter().cloned() { + match export { + ModuleExport::PredicateKey((name, arity)) => { + let name = name.defrock_brackets(); + + match self.get_code_index((name.clone(), arity), mod_name.clone()) { + Some(CodeIndex(ref code_idx)) => { + if &code_idx.borrow().1 != &module.module_decl.name { + continue; } - } - } else if arity == 1 { - if let Some(mod_name) = self.get_op_module_name(name.clone(), Fixity::Pre) { - if mod_name == module.module_decl.name { - self.op_dir().remove(&(name.clone(), Fixity::Pre)); - } - } - if let Some(mod_name) = self.get_op_module_name(name.clone(), Fixity::Post) - { - if mod_name == module.module_decl.name { - self.op_dir().remove(&(name.clone(), Fixity::Post)); + self.remove_code_index((name.clone(), arity)); + + // remove or respecify ops. + if arity == 2 { + if let Some(mod_name) = self.get_op_module_name(name.clone(), Fixity::In) { + if mod_name == module.module_decl.name { + self.op_dir().remove(&(name.clone(), Fixity::In)); + } + } + } else if arity == 1 { + if let Some(mod_name) = self.get_op_module_name(name.clone(), Fixity::Pre) { + if mod_name == module.module_decl.name { + self.op_dir().remove(&(name.clone(), Fixity::Pre)); + } + } + + if let Some(mod_name) = self.get_op_module_name(name.clone(), Fixity::Post) + { + if mod_name == module.module_decl.name { + self.op_dir().remove(&(name.clone(), Fixity::Post)); + } + } } - } - } + } + _ => {} + }; + }, + ModuleExport::OpDecl(op_decl) => { + let op_dir = self.op_dir(); + op_dir.remove(&(op_decl.name(), op_decl.fixity())); } - _ => {} - }; + } } } // returns true on successful import. fn import_decl(&mut self, name: ClauseName, arity: usize, submodule: &Module) -> bool { let name = name.defrock_brackets(); - let mut found_op = false; - - { - let mut insert_op_dir = |fix| { - if let Some(op_data) = submodule.op_dir.get(&(name.clone(), fix)) { - self.op_dir().insert((name.clone(), fix), op_data.clone()); - found_op = true; - } - }; - - if arity == 1 { - insert_op_dir(Fixity::Pre); - insert_op_dir(Fixity::Post); - } else if arity == 2 { - insert_op_dir(Fixity::In); - } - } if let Some(code_data) = submodule.code_dir.get(&(name.clone(), arity)) { let name = name.with_table(submodule.atom_tbl.clone()); @@ -205,7 +196,7 @@ pub trait SubModuleUser { self.insert_dir_entry(name, arity, code_data.clone()); true } else { - found_op || submodule.is_impromptu_module + submodule.is_impromptu_module } } @@ -214,30 +205,58 @@ pub trait SubModuleUser { _: &mut CodeRepo, _: MachineFlags, _: &Module, - _: &Vec, + _: &Vec, + ) -> Result<(), SessionError>; + + fn use_module( + &mut self, + _: &mut CodeRepo, + _: MachineFlags, + _: &Module ) -> Result<(), SessionError>; - fn use_module(&mut self, _: &mut CodeRepo, _: MachineFlags, _: &Module) -> Result<(), SessionError>; } pub fn use_qualified_module( user: &mut User, submodule: &Module, - exports: &Vec, + exports: &Vec, ) -> Result<(), SessionError> where User: SubModuleUser, { - for (name, arity) in exports.iter().cloned() { - if !submodule - .module_decl - .exports - .contains(&(name.clone(), arity)) - { - continue; - } + for export in exports.iter().cloned() { + match export { + ModuleExport::PredicateKey((name, arity)) => { + if !submodule + .module_decl + .exports + .contains(&ModuleExport::PredicateKey((name.clone(), arity))) + { + continue; + } - if !user.import_decl(name, arity, submodule) { - return Err(SessionError::ModuleDoesNotContainExport); + if !user.import_decl(name, arity, submodule) { + return Err(SessionError::ModuleDoesNotContainExport); + } + }, + ModuleExport::OpDecl(op_decl) => { + if !submodule + .module_decl + .exports + .contains(&ModuleExport::OpDecl(op_decl.clone())) + { + continue; + } + + let op_dir = user.op_dir(); + let prec = op_decl.0; + + op_decl.insert_into_op_dir( + submodule.module_decl.name.clone(), + op_dir, + prec, + ); + } } } @@ -248,9 +267,23 @@ pub fn use_module( user: &mut User, submodule: &Module, ) -> Result<(), SessionError> { - for (name, arity) in submodule.module_decl.exports.iter().cloned() { - if !user.import_decl(name, arity, submodule) { - return Err(SessionError::ModuleDoesNotContainExport); + for export in submodule.module_decl.exports.iter().cloned() { + match export { + ModuleExport::PredicateKey((name, arity)) => { + if !user.import_decl(name, arity, submodule) { + return Err(SessionError::ModuleDoesNotContainExport); + } + } + ModuleExport::OpDecl(op_decl) => { + let op_dir = user.op_dir(); + let prec = op_decl.0; + + op_decl.insert_into_op_dir( + submodule.module_decl.name.clone(), + op_dir, + prec, + ); + } } } @@ -283,7 +316,7 @@ impl SubModuleUser for Module { _: &mut CodeRepo, _: MachineFlags, submodule: &Module, - exports: &Vec, + exports: &Vec, ) -> Result<(), SessionError> { use_qualified_module(self, submodule, exports)?; diff --git a/src/prolog/machine/toplevel.rs b/src/prolog/machine/toplevel.rs index 542dd131..823067a4 100644 --- a/src/prolog/machine/toplevel.rs +++ b/src/prolog/machine/toplevel.rs @@ -196,13 +196,13 @@ fn setup_op_decl( to_op_decl(prec, spec.as_str(), name) } -fn setup_predicate_indicator(mut term: Term) -> Result { +fn setup_predicate_indicator(term: &mut Term) -> Result { match term { Term::Clause(_, ref name, ref mut terms, Some(_)) if name.as_str() == "/" && terms.len() == 2 => { let arity = *terms.pop().unwrap(); - let name = *terms.pop().unwrap(); + let name = *terms.pop().unwrap(); let arity = arity .to_constant() @@ -210,7 +210,7 @@ fn setup_predicate_indicator(mut term: Term) -> Result Result>) -> Result { +fn setup_module_export( + mut term: Term, + atom_tbl: TabledData, +) -> Result { + setup_predicate_indicator(&mut term) + .map(ModuleExport::PredicateKey) + .or_else(|_| { + if let Term::Clause(_, name, terms, _) = term { + if terms.len() == 3 && name.as_str() == "op" { + Ok(ModuleExport::OpDecl(setup_op_decl( + terms, + atom_tbl + )?)) + } else { + Err(ParserError::InvalidModuleDecl) + } + } else { + Err(ParserError::InvalidModuleDecl) + } + }) +} + +fn setup_module_decl( + mut terms: Vec>, + atom_tbl: TabledData, +) -> Result { let mut export_list = *terms.pop().unwrap(); let name = terms .pop() @@ -230,10 +255,12 @@ fn setup_module_decl(mut terms: Vec>) -> Result>) -> Result Ok(ModuleSource::File(name.clone())), + Term::Constant(_, Constant::Atom(ref name, _)) => + Ok(ModuleSource::File(name.clone())), _ => Err(ParserError::InvalidUseModuleDecl), } } -type UseModuleExport = (ModuleSource, Vec); +type UseModuleExport = (ModuleSource, Vec); -fn setup_qualified_import(mut terms: Vec>) -> Result { +fn setup_qualified_import( + mut terms: Vec>, + atom_tbl: TabledData, +) -> Result { let mut export_list = *terms.pop().unwrap(); let module_src = match *terms.pop().unwrap() { Term::Clause(_, ref name, ref mut terms, None) @@ -282,10 +313,10 @@ fn setup_qualified_import(mut terms: Vec>) -> Result Err(ParserError::InvalidUseModuleDecl), }?; - let mut exports = Vec::new(); + let mut exports = vec![]; while let Term::Cons(_, t1, t2) = export_list { - exports.push(setup_predicate_indicator(*t1)?); + exports.push(setup_module_export(*t1, atom_tbl.clone())?); export_list = *t2; } @@ -460,19 +491,19 @@ fn setup_declaration<'a, 'b, 'c, R: Read>( ("op", 3) => Ok(Declaration::Op(setup_op_decl(terms, indices.atom_tbl())?)), ("module", 2) => - Ok(Declaration::Module(setup_module_decl(terms)?)), + Ok(Declaration::Module(setup_module_decl(terms, indices.atom_tbl())?)), ("use_module", 1) => Ok(Declaration::UseModule(setup_use_module_decl(terms)?)), ("use_module", 2) => { - let (name, exports) = setup_qualified_import(terms)?; + let (name, exports) = setup_qualified_import(terms, indices.atom_tbl())?; Ok(Declaration::UseQualifiedModule(name, exports)) } ("non_counted_backtracking", 1) => { - let (name, arity) = setup_predicate_indicator(*terms.pop().unwrap())?; + let (name, arity) = setup_predicate_indicator(&mut *terms.pop().unwrap())?; Ok(Declaration::NonCountedBacktracking(name, arity)) } ("dynamic", 1) => { - let (name, arity) = setup_predicate_indicator(*terms.pop().unwrap())?; + let (name, arity) = setup_predicate_indicator(&mut *terms.pop().unwrap())?; Ok(Declaration::Dynamic(name, arity)) } ("initialization", 1) => { diff --git a/src/prolog/toplevel.pl b/src/prolog/toplevel.pl index ba2b0ee9..d04d7b10 100644 --- a/src/prolog/toplevel.pl +++ b/src/prolog/toplevel.pl @@ -134,7 +134,7 @@ ; '$print_exception'(E) ). -'$predicate_indicator'(Source, PI) :- +'$module_export'(Source, PI) :- ( nonvar(PI) -> ( PI = Name / Arity -> ( var(Name) -> throw(error(instantiation_error, Source)) @@ -145,7 +145,20 @@ ) ; throw(error(type_error(integer, Arity), Source)) ) - ; throw(error(type_error(predicate_indicator, PI), Source)) + ; PI = op(Prec, Spec, Name) -> + ( integer(Prec) -> + ( \+ atom(Name) -> + throw(error(type_error(atom, Name), Source)) + ; Prec < 0 -> + throw(error(domain_error(not_less_than_zero, Prec), Source)) + ; Prec > 1200 -> + throw(error(domain_error(operator_precision, Prec), Source)) + ; memberchk(Spec, [xfy, yfx, xfx, fx, fy, yf, xf]) + ; throw(error(domain_error(operator_specification, Spec), Source)) + ) + ; throw(error(type_error(integer, Prec), Source)) + ) + ; throw(error(type_error(module_export, PI), Source)) ) ; throw(error(instantiation_error, Source)) ). @@ -167,9 +180,11 @@ use_module(Module) :- use_module(Module, QualifiedExports) :- ( nonvar(Module) -> ( list_si(QualifiedExports) -> - maplist('$predicate_indicator'(use_module/2), QualifiedExports), !, - ( Module = library(Filename) -> '$use_qualified_module'(Filename, QualifiedExports) - ; atom(Module) -> '$use_qualified_module_from_file'(Module, QualifiedExports) + maplist('$module_export'(use_module/2), QualifiedExports) -> + ( Module = library(Filename) -> + '$use_qualified_module'(Filename, QualifiedExports) + ; atom(Module) -> + '$use_qualified_module_from_file'(Module, QualifiedExports) ; throw(error(invalid_module_specifier, use_module/2)) ) ; throw(error(type_error(list, QualifiedExports), use_module/2)) -- 2.54.0