rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add op/3 to builtin predicates

Browse Source
This commit is contained in:
Mark Thom
2019-03-30 18:14:47 -06:00
parent f55968b1b8
commit 0aefcf7eae
10 changed files with 186 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
src/prolog/clause_types.rs
View File

@@ -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),

59
src/prolog/forms.rs
View File

@@ -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<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(())
}

46
src/prolog/lib/builtins.pl
View File

@@ -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)).

22
src/prolog/machine/compile.rs
View File

@@ -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) =>

16
src/prolog/machine/machine_errors.rs
View File

@@ -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),

48
src/prolog/machine/system_calls.rs
View File

@@ -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 =>

25
src/prolog/machine/toplevel.rs
View File

@@ -115,6 +115,20 @@ fn is_compile_time_hook(name: &ClauseName, terms: &Vec<Box<Term>>) -> Option<Com
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() {
@@ -136,16 +150,7 @@ fn setup_op_decl(mut terms: Vec<Box<Term>>) -> Result<OpDecl, ParserError>
_ => 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>

2
src/prolog/write.rs
View File

@@ -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."),