[package]
name = "scryer-prolog"
-version = "0.8.26"
+version = "0.8.27"
repository = "https://github.com/mthom/scryer-prolog"
description = "A modern Prolog implementation written mostly in Rust."
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"
* `numbervars/2`
* `numlist/{2,3}`
* `once/1`
+* `op/3`
* `partial_string/2`
* `phrase/{2,3}`
* `rational/1`
ExpandTerm,
FetchGlobalVar,
TruncateIfNoLiftedHeapGrowthDiff,
- TruncateIfNoLiftedHeapGrowth,
+ TruncateIfNoLiftedHeapGrowth,
GetAttributedVariableList,
GetAttrVarQueueDelimiter,
GetAttrVarQueueBeyond,
ModuleOf,
ModuleRetractClause,
NoSuchPredicate,
+ OpDeclaration,
RedoAttrVarBindings,
RemoveCallPolicyCheck,
RemoveInferenceCounter,
&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"),
("$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),
use prolog_parser::ast::*;
+use prolog_parser::parser::OpDesc;
use prolog_parser::tabled_rc::*;
use prolog::clause_types::*;
}
}
- 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<OpDesc>, 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(())
}
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]).
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)).
use prolog_parser::ast::*;
+use prolog_parser::parser::get_desc;
use prolog_parser::tabled_rc::TabledData;
use prolog::instructions::*;
},
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) =>
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());
#[derive(Clone, Copy)]
pub enum PermissionError {
Access,
+ Create,
Modify,
}
pub fn as_str(self) -> &'static str {
match self {
PermissionError::Access => "access",
+ PermissionError::Create => "create",
PermissionError::Modify => "modify"
}
}
ModuleDoesNotContainExport,
ModuleNotFound,
NamelessEntry,
- OpIsInfixAndPostFix,
+ OpIsInfixAndPostFix(ClauseName),
ParserError(ParserError),
QueryFailure,
QueryFailureWithException(ClauseName),
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::*;
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};
_ => 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 =>
type CompileTimeHookCompileInfo = (CompileTimeHook, PredicateClause, VecDeque<TopLevel>);
+pub fn to_op_decl(prec: usize, spec: &str, name: ClauseName) -> Result<OpDecl, ParserError>
+{
+ 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<Box<Term>>) -> Result<OpDecl, ParserError>
{
let name = match *terms.pop().unwrap() {
_ => 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<PredicateKey, ParserError>
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."),
projects / scryer-prolog.git / commitdiff