From: Mark Thom Date: Sun, 31 Mar 2019 00:14:47 +0000 (-0600) Subject: add op/3 to builtin predicates X-Git-Tag: v0.8.110~141 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=0aefcf7eae3bc5d5764cabc72978cb94d271330e;p=scryer-prolog.git add op/3 to builtin predicates --- diff --git a/Cargo.toml b/Cargo.toml index 6414320c..98ba7e63 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -1,6 +1,6 @@ [package] name = "scryer-prolog" -version = "0.8.26" +version = "0.8.27" authors = ["Mark Thom "] repository = "https://github.com/mthom/scryer-prolog" description = "A modern Prolog implementation written mostly in Rust." @@ -14,7 +14,7 @@ cfg-if = "0.1.7" downcast = "0.10.0" num = "0.2" ordered-float = "0.5.0" -prolog_parser = "0.8.6" +prolog_parser = "0.8.7" readline_rs_compat = { version = "0.1.7", optional = true } ref_thread_local = "0.0.0" diff --git a/README.md b/README.md index 9e22f234..0b9ebf99 100644 --- a/README.md +++ b/README.md @@ -203,6 +203,7 @@ The following predicates are built-in to Scryer. * `numbervars/2` * `numlist/{2,3}` * `once/1` +* `op/3` * `partial_string/2` * `phrase/{2,3}` * `rational/1` diff --git a/src/prolog/clause_types.rs b/src/prolog/clause_types.rs index 405a6106..82b57c45 100644 --- a/src/prolog/clause_types.rs +++ b/src/prolog/clause_types.rs @@ -174,7 +174,7 @@ pub enum SystemClauseType { ExpandTerm, FetchGlobalVar, TruncateIfNoLiftedHeapGrowthDiff, - TruncateIfNoLiftedHeapGrowth, + TruncateIfNoLiftedHeapGrowth, GetAttributedVariableList, GetAttrVarQueueDelimiter, GetAttrVarQueueBeyond, @@ -195,6 +195,7 @@ pub enum SystemClauseType { ModuleOf, ModuleRetractClause, NoSuchPredicate, + OpDeclaration, RedoAttrVarBindings, RemoveCallPolicyCheck, RemoveInferenceCounter, @@ -261,6 +262,7 @@ impl SystemClauseType { &SystemClauseType::GetSCCCleaner => clause_name!("$get_scc_cleaner"), &SystemClauseType::Halt => clause_name!("$halt"), &SystemClauseType::HeadIsDynamic => clause_name!("$head_is_dynamic"), + &SystemClauseType::OpDeclaration => clause_name!("$op$"), &SystemClauseType::InstallSCCCleaner => clause_name!("$install_scc_cleaner"), &SystemClauseType::InstallInferenceCounter => clause_name!("$install_inference_counter"), &SystemClauseType::LiftedHeapLength => clause_name!("$lh_length"), @@ -338,6 +340,7 @@ impl SystemClauseType { ("$module_retract_clause", 5) => Some(SystemClauseType::ModuleRetractClause), ("$module_head_is_dynamic", 2) => Some(SystemClauseType::ModuleHeadIsDynamic), ("$no_such_predicate", 1) => Some(SystemClauseType::NoSuchPredicate), + ("$op", 3) => Some(SystemClauseType::OpDeclaration), ("$redo_attr_var_bindings", 0) => Some(SystemClauseType::RedoAttrVarBindings), ("$remove_call_policy_check", 1) => Some(SystemClauseType::RemoveCallPolicyCheck), ("$remove_inference_counter", 2) => Some(SystemClauseType::RemoveInferenceCounter), diff --git a/src/prolog/forms.rs b/src/prolog/forms.rs index 324e31b0..04f48899 100644 --- a/src/prolog/forms.rs +++ b/src/prolog/forms.rs @@ -1,4 +1,5 @@ use prolog_parser::ast::*; +use prolog_parser::parser::OpDesc; use prolog_parser::tabled_rc::*; use prolog::clause_types::*; @@ -186,37 +187,55 @@ impl OpDecl { } } - pub fn submit(&self, module: ClauseName, op_dir: &mut OpDir) -> Result<(), SessionError> + pub fn remove(&self, op_dir: &mut OpDir) { + let (spec, name) = (self.1, self.2.clone()); + + if is_prefix!(spec) { + op_dir.remove(&(name.clone(), Fixity::Pre)); + } + + if is_infix!(spec) { + op_dir.remove(&(name.clone(), Fixity::In)); + } + + if is_postfix!(spec) { + op_dir.remove(&(name, Fixity::Post)); + } + } + + pub fn submit(&self, module: ClauseName, existing_desc: Option, op_dir: &mut OpDir) + -> Result<(), SessionError> { let (prec, spec, name) = (self.0, self.1, self.2.clone()); if is_infix!(spec) { - match op_dir.get(&(name.clone(), Fixity::Post)) { - Some(_) => return Err(SessionError::OpIsInfixAndPostFix), - _ => {} + if let Some(desc) = existing_desc { + if desc.post > 0 { + return Err(SessionError::OpIsInfixAndPostFix(name)); + } }; } if is_postfix!(spec) { - match op_dir.get(&(name.clone(), Fixity::In)) { - Some(_) => return Err(SessionError::OpIsInfixAndPostFix), - _ => {} + if let Some(desc) = existing_desc { + if desc.inf > 0 { + return Err(SessionError::OpIsInfixAndPostFix(name)); + } }; } - if prec > 0 { - match spec { - XFY | XFX | YFX => op_dir.insert((name.clone(), Fixity::In), - (spec, prec, module.clone())), - XF | YF => op_dir.insert((name.clone(), Fixity::Post), (spec, prec, module.clone())), - FX | FY => op_dir.insert((name.clone(), Fixity::Pre), (spec, prec, module.clone())), - _ => None - }; - } else { - op_dir.remove(&(name.clone(), Fixity::Pre)); - op_dir.remove(&(name.clone(), Fixity::In)); - op_dir.remove(&(name.clone(), Fixity::Post)); - } + match spec { + XFY | XFX | YFX => { + op_dir.insert((name.clone(), Fixity::In), (spec, prec, module.clone())); + }, + XF | YF => { + op_dir.insert((name.clone(), Fixity::Post), (spec, prec, module.clone())); + }, + FX | FY => { + op_dir.insert((name.clone(), Fixity::Pre), (spec, prec, module.clone())); + }, + _ => {} + }; Ok(()) } diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index ce95a256..99307e52 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -10,7 +10,7 @@ call_cleanup/2, call_with_inference_limit/3, catch/3, clause/2, current_predicate/1, current_prolog_flag/2, expand_goal/2, expand_term/2, findall/3, findall/4, halt/0, - once/1, repeat/0, retract/1, set_prolog_flag/2, setof/3, + once/1, op/3, repeat/0, retract/1, set_prolog_flag/2, setof/3, setup_call_cleanup/3, term_variables/2, throw/1, true/0, false/0, write/1, write_canonical/1, writeq/1, write_term/2]). @@ -693,6 +693,50 @@ current_predicate(Pred) :- between:between(0, Max, N) ). +list_of_op_atoms(Var) :- + var(Var), throw(error(instantiation_error, op/3)). % 8.14.3.3 c) +list_of_op_atoms([Atom|Atoms]) :- + ( valid_op(Atom) -> list_of_op_atoms(Atoms) % 8.14.3.3 k). + ; var(Atom) -> throw(error(instantiation_error, op/3)) % 8.14.3.3 c) + ; throw(error(type_error(atom, Atom), op/3)) % 8.14.3.3 g) + ). +list_of_op_atoms([]). + +op_priority(Priority) :- + integer(Priority), !, + ( ( Priority < 0 ; Priority > 1200 ) -> + throw(error(domain_error(operator_priority, Priority))) % 8.14.3.3 h) + ; true + ). +op_priority(Priority) :- + throw(error(type_error(integer, Priority), op/3)). % 8.14.3.3 d) + +op_specifier(OpSpec) :- atom(OpSpec), + ( lists:member(OpSpec, [yfx, xfy, xfx, yf, fy, xf, fx]), ! + ; throw(error(domain_error(operator_specifier, OpSpec), op/3)) % 8.14.3.3 i) + ). +op_specifier(OpSpec) :- throw(error(type_error(atom, OpSpec), op/3)). + +valid_op(Op) :- atom(Op), + ( Op \== ',' -> true + ; throw(error(permission_error(modify, operator, ','), op/3)) % 8.14.3.3 j), k). + ). + +op_(Priority, OpSpec, Op) :- '$op'(Priority, OpSpec, Op). + +op(Priority, OpSpec, Op) :- + ( var(Priority) -> throw(error(instantiation_error, op/3)) % 8.14.3.3 a) + ; var(OpSpec) -> throw(error(instantiation_error, op/3)) % 8.14.3.3 b) + ; var(Op) -> throw(error(instantiation_error, op/3)) % 8.14.3.3 c) + ; valid_op(Op), op_priority(Priority), op_specifier(OpSpec) -> + '$op'(Priority, OpSpec, Op) + ; list_of_op_atoms(Op), op_priority(Priority), op_specifier(OpSpec) -> + lists:maplist(op_(Priority, OpSpec), Op), ! + ; throw(error(type_error(list, Op), op/3)) % 8.14.3.3 f) + ). + +%% (non-)backtrackable global variables. + bb_put(Key, Value) :- atom(Key), !, '$store_global_var'(Key, Value). bb_put(Key, _) :- throw(error(type_error(atom, Key), bb_put/2)). diff --git a/src/prolog/machine/compile.rs b/src/prolog/machine/compile.rs index ec615a46..8e49fa5b 100644 --- a/src/prolog/machine/compile.rs +++ b/src/prolog/machine/compile.rs @@ -1,4 +1,5 @@ use prolog_parser::ast::*; +use prolog_parser::parser::get_desc; use prolog_parser::tabled_rc::TabledData; use prolog::instructions::*; @@ -551,8 +552,25 @@ impl ListingCompiler { }, Declaration::NonCountedBacktracking(name, arity) => Ok(self.add_non_counted_bt_flag(name, arity)), - Declaration::Op(op_decl) => - op_decl.submit(self.get_module_name(), &mut indices.op_dir), + Declaration::Op(op_decl) => { + let existing_desc = { + let comp_ops = composite_op!(self.module.is_some(), &wam_indices.op_dir, + &mut indices.op_dir); + + get_desc(op_decl.name(), comp_ops) + }; + + if op_decl.0 == 0 { + // remove all instances of the operator. + if self.module.is_none() { + op_decl.remove(&mut wam_indices.op_dir); + } + + Ok(()) + } else { + op_decl.submit(self.get_module_name(), existing_desc, &mut indices.op_dir) + } + }, Declaration::UseModule(name) => self.use_module(name, code_repo, flags, wam_indices, indices), Declaration::UseQualifiedModule(name, exports) => diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index 5502688a..8a72660d 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -68,23 +68,29 @@ impl MachineError { SessionError::ParserError(err) => Self::syntax_error(h, err), SessionError::CannotOverwriteBuiltIn(pred_str) | SessionError::CannotOverwriteImport(pred_str) => - Self::permission_error(PermissionError::Modify, pred_str), + Self::permission_error(PermissionError::Modify, "private_procedure", pred_str), SessionError::ModuleDoesNotContainExport => Self::permission_error(PermissionError::Access, + "private_procedure", clause_name!("module_does_not_contain_claimed_export")), SessionError::ModuleNotFound => Self::permission_error(PermissionError::Access, + "private_procedure", clause_name!("module_does_not_exist")), + SessionError::OpIsInfixAndPostFix(op) => + Self::permission_error(PermissionError::Create, + "operator", + op), _ => unreachable!() } } pub(super) - fn permission_error(err: PermissionError, pred_str: ClauseName) -> Self + fn permission_error(err: PermissionError, index_str: &'static str, pred_str: ClauseName) -> Self { let pred_str = HeapCellValue::Addr(Addr::Con(Constant::Atom(pred_str, None))); - let err = vec![heap_atom!(err.as_str()), heap_atom!("private_procedure"), pred_str]; + let err = vec![heap_atom!(err.as_str()), heap_atom!(index_str), pred_str]; let mut stub = functor!("permission_error", 3); stub.extend(err.into_iter()); @@ -144,6 +150,7 @@ impl MachineError { #[derive(Clone, Copy)] pub enum PermissionError { Access, + Create, Modify, } @@ -151,6 +158,7 @@ impl PermissionError { pub fn as_str(self) -> &'static str { match self { PermissionError::Access => "access", + PermissionError::Create => "create", PermissionError::Modify => "modify" } } @@ -375,7 +383,7 @@ pub enum SessionError { ModuleDoesNotContainExport, ModuleNotFound, NamelessEntry, - OpIsInfixAndPostFix, + OpIsInfixAndPostFix(ClauseName), ParserError(ParserError), QueryFailure, QueryFailureWithException(ClauseName), diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index 0901cd1f..33247086 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -1,5 +1,5 @@ use prolog_parser::ast::*; -use prolog_parser::parser::get_clause_spec; +use prolog_parser::parser::{get_desc, get_clause_spec}; use prolog::clause_types::*; use prolog::heap_iter::*; @@ -8,6 +8,7 @@ use prolog::machine::copier::*; use prolog::machine::machine_errors::*; use prolog::machine::machine_indices::*; use prolog::machine::machine_state::*; +use prolog::machine::toplevel::to_op_decl; use prolog::num::{FromPrimitive, ToPrimitive, Zero}; use prolog::num::bigint::{BigInt}; @@ -568,6 +569,51 @@ impl MachineState { _ => self.fail = true } }, + &SystemClauseType::OpDeclaration => { + let priority = self[temp_v!(1)].clone(); + let specifier = self[temp_v!(2)].clone(); + let op = self[temp_v!(3)].clone(); + + let priority = match self.store(self.deref(priority)) { + Addr::Con(Constant::Number(Number::Integer(n))) => n.to_usize().unwrap(), + _ => unreachable!() + }; + + let specifier = match self.store(self.deref(specifier)) { + Addr::Con(Constant::Atom(name, _)) => name, + _ => unreachable!() + }; + + let op = match self.store(self.deref(op)) { + Addr::Con(Constant::Atom(name, _)) => name, + _ => unreachable!() + }; + + let module = op.owning_module(); + + let result = to_op_decl(priority, specifier.as_str(), op) + .map_err(SessionError::from) + .and_then(|op_decl| { + if op_decl.0 == 0 { + Ok(op_decl.remove(&mut indices.op_dir)) + } else { + let desc = get_desc(op_decl.name(), composite_op!(&indices.op_dir)); + op_decl.submit(module, desc, &mut indices.op_dir) + } + }); + + match result { + Ok(()) => {}, + Err(e) => { + // 8.14.3.3 l) + let e = MachineError::session_error(self.heap.h, e); + let stub = MachineError::functor_stub(clause_name!("op"), 3); + let permission_error = self.error_form(e, stub); + + return Err(permission_error); + } + }; + }, &SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff => self.truncate_if_no_lifted_heap_diff(|h| Addr::HeapCell(h)), &SystemClauseType::TruncateIfNoLiftedHeapGrowth => diff --git a/src/prolog/machine/toplevel.rs b/src/prolog/machine/toplevel.rs index cb1efed0..113251d5 100644 --- a/src/prolog/machine/toplevel.rs +++ b/src/prolog/machine/toplevel.rs @@ -115,6 +115,20 @@ fn is_compile_time_hook(name: &ClauseName, terms: &Vec>) -> Option); +pub fn to_op_decl(prec: usize, spec: &str, name: ClauseName) -> Result +{ + match spec { + "xfx" => Ok(OpDecl(prec, XFX, name)), + "xfy" => Ok(OpDecl(prec, XFY, name)), + "yfx" => Ok(OpDecl(prec, YFX, name)), + "fx" => Ok(OpDecl(prec, FX, name)), + "fy" => Ok(OpDecl(prec, FY, name)), + "xf" => Ok(OpDecl(prec, XF, name)), + "yf" => Ok(OpDecl(prec, YF, name)), + _ => Err(ParserError::InconsistentEntry) + } +} + fn setup_op_decl(mut terms: Vec>) -> Result { let name = match *terms.pop().unwrap() { @@ -136,16 +150,7 @@ fn setup_op_decl(mut terms: Vec>) -> Result _ => return Err(ParserError::InconsistentEntry) }; - match spec.as_str() { - "xfx" => Ok(OpDecl(prec, XFX, name)), - "xfy" => Ok(OpDecl(prec, XFY, name)), - "yfx" => Ok(OpDecl(prec, YFX, name)), - "fx" => Ok(OpDecl(prec, FX, name)), - "fy" => Ok(OpDecl(prec, FY, name)), - "xf" => Ok(OpDecl(prec, XF, name)), - "yf" => Ok(OpDecl(prec, YF, name)), - _ => Err(ParserError::InconsistentEntry) - } + to_op_decl(prec, spec.as_str(), name) } fn setup_predicate_indicator(mut term: Term) -> Result diff --git a/src/prolog/write.rs b/src/prolog/write.rs index d635dcab..51e65827 100644 --- a/src/prolog/write.rs +++ b/src/prolog/write.rs @@ -264,7 +264,7 @@ impl fmt::Display for SessionError { write!(f, "false."), &SessionError::QueryFailureWithException(ref e) => write!(f, "{}", error_string(e)), - &SessionError::OpIsInfixAndPostFix => + &SessionError::OpIsInfixAndPostFix(_) => write!(f, "cannot define an op to be both postfix and infix."), &SessionError::NamelessEntry => write!(f, "the predicate head is not an atom or clause."),