add op/3 to builtin predicates

2019-03-30 18:14:47 -06:00
parent f55968b1b8
commit 0aefcf7eae
10 changed files with 186 additions and 42 deletions
--- 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 <markjordanthom@gmail.com>"]
 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"

--- 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`
--- a/src/prolog/clause_types.rs
+++ b/src/prolog/clause_types.rs
@@ -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),
--- 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<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
+            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()));
+            },
+            _ => {}
        };
-        } else {
-            op_dir.remove(&(name.clone(), Fixity::Pre));
-            op_dir.remove(&(name.clone(), Fixity::In));
-            op_dir.remove(&(name.clone(), Fixity::Post));
-        }

        Ok(())
    }
--- 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)).

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