From 272b4f6d8df720f4fa2e019ecc261d7dd4436764 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Fri, 5 Apr 2019 21:25:49 -0600 Subject: [PATCH] add current_op/3 --- Cargo.toml | 4 +- README.md | 1 + src/prolog/clause_types.rs | 6 ++ src/prolog/lib/builtins.pl | 19 +++- src/prolog/machine/machine_indices.rs | 8 +- src/prolog/machine/system_calls.rs | 127 +++++++++++++++++++++++++- src/prolog/write.rs | 6 +- 7 files changed, 160 insertions(+), 11 deletions(-) diff --git a/Cargo.toml b/Cargo.toml index 64cc437c..5a3e8386 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -1,6 +1,6 @@ [package] name = "scryer-prolog" -version = "0.8.41" +version = "0.8.42" 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.15" +prolog_parser = "0.8.16" readline_rs_compat = { version = "0.1.7", optional = true } ref_thread_local = "0.0.0" diff --git a/README.md b/README.md index fde73737..13393927 100644 --- a/README.md +++ b/README.md @@ -175,6 +175,7 @@ The following predicates are built-in to Scryer. * `compound/1` * `copy_term/2` * `current_predicate/1` +* `current_op/3` * `cyclic_term/1` * `dif/2` * `expand_goal/2` diff --git a/src/prolog/clause_types.rs b/src/prolog/clause_types.rs index 30dde564..e60a7a4c 100644 --- a/src/prolog/clause_types.rs +++ b/src/prolog/clause_types.rs @@ -180,7 +180,9 @@ pub enum SystemClauseType { GetClause, GetModuleClause, GetNextDBRef, + GetNextOpDBRef, LookupDBRef, + LookupOpDBRef, Halt, ModuleHeadIsDynamic, GetLiftedHeapFromOffset, @@ -254,7 +256,9 @@ impl SystemClauseType { &SystemClauseType::GetBValue => clause_name!("$get_b_value"), &SystemClauseType::GetClause => clause_name!("$get_clause"), &SystemClauseType::GetNextDBRef => clause_name!("$get_next_db_ref"), + &SystemClauseType::GetNextOpDBRef => clause_name!("$get_next_op_db_ref"), &SystemClauseType::LookupDBRef => clause_name!("$lookup_db_ref"), + &SystemClauseType::LookupOpDBRef => clause_name!("$lookup_op_db_ref"), &SystemClauseType::GetDoubleQuotes => clause_name!("$get_double_quotes"), &SystemClauseType::GetModuleClause => clause_name!("$get_module_clause"), &SystemClauseType::GetSCCCleaner => clause_name!("$get_scc_cleaner"), @@ -312,7 +316,9 @@ impl SystemClauseType { ("$del_attr_non_head", 1) => Some(SystemClauseType::DeleteAttribute), ("$del_attr_head", 1) => Some(SystemClauseType::DeleteHeadAttribute), ("$get_next_db_ref", 2) => Some(SystemClauseType::GetNextDBRef), + ("$get_next_op_db_ref", 2) => Some(SystemClauseType::GetNextOpDBRef), ("$lookup_db_ref", 3) => Some(SystemClauseType::LookupDBRef), + ("$lookup_op_db_ref", 4) => Some(SystemClauseType::LookupOpDBRef), ("$module_call", 2) => Some(SystemClauseType::DynamicModuleResolution), ("$enqueue_attribute_goal", 1) => Some(SystemClauseType::EnqueueAttributeGoal), ("$enqueue_attr_var", 1) => Some(SystemClauseType::EnqueueAttributedVar), diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 24711315..271680f8 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -9,9 +9,9 @@ abolish/1, asserta/1, assertz/1, bagof/3, bb_b_put/2, bb_get/2, bb_put/2, 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, op/3, - repeat/0, retract/1, set_prolog_flag/2, setof/3, + current_predicate/1, current_op/3, current_prolog_flag/2, + expand_goal/2, expand_term/2, findall/3, findall/4, halt/0, + 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]). @@ -714,6 +714,19 @@ current_predicate(Pred) :- between:between(0, Max, N) ). +'$iterate_op_db_refs'(Ref, Priority, Spec, Op) :- + '$lookup_op_db_ref'(Ref, Priority, Spec, Op). +'$iterate_op_db_refs'(Ref, Priority, Spec, Op) :- + '$get_next_op_db_ref'(Ref, NextRef), + '$iterate_op_db_refs'(NextRef, Priority, Spec, Op). + +current_op(Priority, Spec, Op) :- + ( nonvar(Op), \+ atom(Op) + -> throw(error(type_error(atom, Op), current_op/3)) + ; '$get_next_op_db_ref'(Ref, _), + '$iterate_op_db_refs'(Ref, Priority, Spec, Op) + ). + list_of_op_atoms(Var) :- var(Var), throw(error(instantiation_error, op/3)). % 8.14.3.3 c) list_of_op_atoms([Atom|Atoms]) :- diff --git a/src/prolog/machine/machine_indices.rs b/src/prolog/machine/machine_indices.rs index 3b338818..00945f0d 100644 --- a/src/prolog/machine/machine_indices.rs +++ b/src/prolog/machine/machine_indices.rs @@ -12,10 +12,16 @@ use std::mem; use std::ops::{Add, AddAssign, Sub, SubAssign}; use std::rc::Rc; +#[derive(Clone, PartialEq, Eq, PartialOrd, Ord, Hash)] +pub struct OrderedOpDirKey(pub ClauseName, pub Fixity); + +pub type OssifiedOpDir = BTreeMap; + #[derive(Clone, PartialEq, Eq, Hash)] pub enum DBRef { BuiltInPred(ClauseName, usize, Option), - NamedPred(ClauseName, usize, Option) + NamedPred(ClauseName, usize, Option), + Op(usize, Specifier, ClauseName, Rc, SharedOpDesc) } #[derive(Clone, PartialEq, Eq, Hash)] diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs index a05b607b..9555c2b2 100644 --- a/src/prolog/machine/system_calls.rs +++ b/src/prolog/machine/system_calls.rs @@ -268,6 +268,30 @@ impl MachineState { }, None => self.fail = true } + }, + &DBRef::Op(_, spec, ref name, ref op_dir, _) => { + let fixity = match spec { + XF | YF => Fixity::Post, + FX | FY => Fixity::Pre, + _ => Fixity::In + }; + + let key = OrderedOpDirKey(name.clone(), fixity); + + match op_dir.range(key ..).skip(1).next() { + Some((OrderedOpDirKey(name, _), (priority, spec))) => { + let a2 = self[temp_v!(2)].clone(); + + if let Some(r) = a2.as_var() { + self.bind(r, Addr::DBRef(DBRef::Op(*priority, *spec, name.clone(), + op_dir.clone(), + SharedOpDesc::new(*priority, *spec)))); + } else { + self.fail = true; + } + }, + None => self.fail = true + } } } } @@ -540,6 +564,7 @@ impl MachineState { return Ok(()); } }, + Addr::DBRef(DBRef::Op(..)) => self.fail = true, Addr::DBRef(ref db_ref) => self.get_next_db_ref(&indices, db_ref), _ => { @@ -547,6 +572,55 @@ impl MachineState { } }; }, + &SystemClauseType::GetNextOpDBRef => { + let a1 = self[temp_v!(1)].clone(); + + match self.store(self.deref(a1)) { + addr @ Addr::HeapCell(_) + | addr @ Addr::StackCell(..) + | addr @ Addr::AttrVar(_) => { + let mut unossified_op_dir = OssifiedOpDir::new(); + + unossified_op_dir.extend(indices.op_dir.iter().filter_map(|(key, op_dir_val)| { + let (name, fixity) = key.clone(); + + let prec = op_dir_val.shared_op_desc().prec(); + + if prec == 0 { + return None; + } + + let assoc = op_dir_val.shared_op_desc().assoc(); + + Some((OrderedOpDirKey(name, fixity), (prec, assoc))) + })); + + let ossified_op_dir = Rc::new(unossified_op_dir); + + match ossified_op_dir.iter().next() { + Some((OrderedOpDirKey(name, _), (priority, spec))) => { + let db_ref = DBRef::Op(*priority, *spec, name.clone(), + ossified_op_dir.clone(), + SharedOpDesc::new(*priority, *spec)); + let r = addr.as_var().unwrap(); + + self.bind(r, Addr::DBRef(db_ref)); + }, + None => { + self.fail = true; + return Ok(()); + } + } + }, + Addr::DBRef(DBRef::BuiltInPred(..)) | Addr::DBRef(DBRef::NamedPred(..)) => + self.fail = true, + Addr::DBRef(ref db_ref) => + self.get_next_db_ref(&indices, db_ref), + _ => { + self.fail = true; + } + } + }, &SystemClauseType::LookupDBRef => { let a1 = self[temp_v!(1)].clone(); @@ -564,14 +638,61 @@ impl MachineState { if !self.fail { self.unify(a3, Addr::Con(Constant::Number(arity))); } - } + }, + _ => self.fail = true + }, + _ => self.fail = true + } + }, + &SystemClauseType::LookupOpDBRef => { + let a1 = self[temp_v!(1)].clone(); + + match self.store(self.deref(a1)) { + Addr::DBRef(db_ref) => + match db_ref { + DBRef::Op(priority, spec, name, _, shared_op_desc) => { + + + let prec = self[temp_v!(2)].clone(); + let specifier = self[temp_v!(3)].clone(); + let op = self[temp_v!(4)].clone(); + + let spec = match spec { + FX => "fx", + FY => "fy", + XF => "xf", + YF => "yf", + XFX => "xfx", + XFY => "xfy", + YFX => "yfx", + _ => { + self.fail = true; + return Ok(()); + } + }; + + let a2 = Number::Integer(Rc::new(BigInt::from_usize(priority).unwrap())); + let a3 = Addr::Con(Constant::Atom(clause_name!(spec), None)); + let a4 = Addr::Con(Constant::Atom(name, Some(shared_op_desc))); + + self.unify(Addr::Con(Constant::Number(a2)), prec); + + if !self.fail { + self.unify(a3, specifier); + } + + if !self.fail { + self.unify(a4, op); + } + }, + _ => self.fail = true }, _ => self.fail = true } }, &SystemClauseType::OpDeclaration => { let priority = self[temp_v!(1)].clone(); - let specifier = self[temp_v!(2)].clone(); + let specifier = self[temp_v!(2)].clone(); let op = self[temp_v!(3)].clone(); let priority = match self.store(self.deref(priority)) { @@ -595,7 +716,7 @@ impl MachineState { let result = to_op_decl(priority, specifier.as_str(), op) .map_err(SessionError::from) - .and_then(|op_decl| { + .and_then(|op_decl| { if op_decl.0 == 0 { Ok(op_decl.remove(&mut indices.op_dir)) } else { diff --git a/src/prolog/write.rs b/src/prolog/write.rs index fae1f63b..cc83ad03 100644 --- a/src/prolog/write.rs +++ b/src/prolog/write.rs @@ -162,8 +162,10 @@ impl fmt::Display for HeapCellValue { impl fmt::Display for DBRef { fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { match self { - &DBRef::BuiltInPred(ref name, arity, _) => write!(f, "db_ref:builtin:{}/{}", name, arity), - &DBRef::NamedPred(ref name, arity, _) => write!(f, "db_ref:named:{}/{}", name, arity) + &DBRef::BuiltInPred(ref name, arity, _) => write!(f, "db_ref:builtin:{}/{}", name, arity), + &DBRef::NamedPred(ref name, arity, _) => write!(f, "db_ref:named:{}/{}", name, arity), + &DBRef::Op(priority, spec, ref name, ..) => write!(f, "db_ref:op({}, {}, {})", priority, + spec, name) } } } -- 2.54.0