From: Mark Thom Date: Sun, 11 Mar 2018 23:37:29 +0000 (-0600) Subject: add sort, keysort. X-Git-Tag: v0.8.110~526 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=acdb3f2c452699314aaf696deb97c1555178318e;p=scryer-prolog.git add sort, keysort. --- diff --git a/README.md b/README.md index 7dfb1378..0b1b996f 100644 --- a/README.md +++ b/README.md @@ -140,6 +140,7 @@ The following predicates are built-in to rusty-wam. * `ground/1` * `integer/1` * `is_list/1` +* `keysort/2` * `length/2` * `maplist/1..8` * `member/2` @@ -150,6 +151,7 @@ The following predicates are built-in to rusty-wam. * `reverse/2` * `select/3` * `setup_call_cleanup/3` +* `sort/2` * `string/1` * `throw/1` * `true/0` diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index 2ab59feb..e090828e 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -686,10 +686,12 @@ pub enum ClauseType { Ground, Inlined(InlinedClauseType), Is, + KeySort, NotEq, Op(ClauseName, Fixity), Named(ClauseName), SetupCallCleanup, + Sort, Throw, } @@ -773,24 +775,26 @@ impl ClauseName { impl ClauseType { pub fn name(&self) -> ClauseName { match self { - &ClauseType::Arg => ClauseName::BuiltIn("arg"), - &ClauseType::CallN => ClauseName::BuiltIn("call"), - &ClauseType::CallWithInferenceLimit => ClauseName::BuiltIn("call_with_inference_limit"), - &ClauseType::Catch => ClauseName::BuiltIn("catch"), - &ClauseType::Compare => ClauseName::BuiltIn("compare"), - &ClauseType::CompareTerm(qt) => ClauseName::BuiltIn(qt.name()), - &ClauseType::Display => ClauseName::BuiltIn("display"), - &ClauseType::DuplicateTerm => ClauseName::BuiltIn("duplicate_term"), - &ClauseType::Eq => ClauseName::BuiltIn("=="), - &ClauseType::Functor => ClauseName::BuiltIn("functor"), - &ClauseType::Ground => ClauseName::BuiltIn("ground"), - &ClauseType::Inlined(inlined) => ClauseName::BuiltIn(inlined.name()), - &ClauseType::Is => ClauseName::BuiltIn("is"), - &ClauseType::NotEq => ClauseName::BuiltIn("\\=="), + &ClauseType::Arg => clause_name!("arg"), + &ClauseType::CallN => clause_name!("call"), + &ClauseType::CallWithInferenceLimit => clause_name!("call_with_inference_limit"), + &ClauseType::Catch => clause_name!("catch"), + &ClauseType::Compare => clause_name!("compare"), + &ClauseType::CompareTerm(qt) => clause_name!(qt.name()), + &ClauseType::Display => clause_name!("display"), + &ClauseType::DuplicateTerm => clause_name!("duplicate_term"), + &ClauseType::Eq => clause_name!("=="), + &ClauseType::Functor => clause_name!("functor"), + &ClauseType::Ground => clause_name!("ground"), + &ClauseType::Inlined(inlined) => clause_name!(inlined.name()), + &ClauseType::Is => clause_name!("is"), + &ClauseType::KeySort => clause_name!("keysort"), + &ClauseType::NotEq => clause_name!("\\=="), &ClauseType::Op(ref name, _) => name.clone(), &ClauseType::Named(ref name) => name.clone(), - &ClauseType::SetupCallCleanup => ClauseName::BuiltIn("setup_call_cleanup"), - &ClauseType::Throw => ClauseName::BuiltIn("throw") + &ClauseType::SetupCallCleanup => clause_name!("setup_call_cleanup"), + &ClauseType::Sort => clause_name!("sort"), + &ClauseType::Throw => clause_name!("throw") } } @@ -813,8 +817,10 @@ impl ClauseType { ("functor", 3) => ClauseType::Functor, ("ground", 1) => ClauseType::Ground, ("is", 2) => ClauseType::Is, + ("keysort", 2) => ClauseType::KeySort, ("\\==", 2) => ClauseType::NotEq, ("setup_call_cleanup", 3) => ClauseType::SetupCallCleanup, + ("sort", 2) => ClauseType::Sort, ("throw", 1) => ClauseType::Throw, _ => if let Some(fixity) = fixity { ClauseType::Op(name, fixity) @@ -1257,13 +1263,17 @@ pub enum ControlInstruction { GotoExecute(usize, usize), // p, arity. GroundCall, GroundExecute, - JmpByCall(usize, usize), // arity, global_offset. - JmpByExecute(usize, usize), IsCall(RegType, ArithmeticTerm), IsExecute(RegType, ArithmeticTerm), + JmpByCall(usize, usize), // arity, global_offset. + JmpByExecute(usize, usize), + KeySortCall, + KeySortExecute, NotEqCall, NotEqExecute, Proceed, + SortCall, + SortExecute, ThrowCall, ThrowExecute, } @@ -1305,6 +1315,10 @@ impl ControlInstruction { &ControlInstruction::JmpByExecute(..) => true, &ControlInstruction::CompareCall => true, &ControlInstruction::CompareExecute => true, + &ControlInstruction::SortCall => true, + &ControlInstruction::SortExecute => true, + &ControlInstruction::KeySortCall => true, + &ControlInstruction::KeySortExecute => true, _ => false } } @@ -1429,7 +1443,7 @@ pub enum HeapCellValue { impl HeapCellValue { pub fn as_addr(&self, focus: usize) -> Addr { match self { - &HeapCellValue::Addr(ref a) => a.clone(), + &HeapCellValue::Addr(ref a) => a.clone(), &HeapCellValue::NamedStr(_, _, _) => Addr::Str(focus) } } diff --git a/src/prolog/codegen.rs b/src/prolog/codegen.rs index b770a693..3ca845d8 100644 --- a/src/prolog/codegen.rs +++ b/src/prolog/codegen.rs @@ -240,12 +240,16 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator code.push(Line::Control(ControlInstruction::FunctorCall)), &ClauseType::Inlined(_) => code.push(proceed!()), + &ClauseType::KeySort => + code.push(keysort_call!()), &ClauseType::NotEq => code.push(Line::Control(ControlInstruction::NotEqCall)), &ClauseType::Named(ref name) | &ClauseType::Op(ref name, _) => { let call = ControlInstruction::Call(name.clone(), terms.len(), pvs); code.push(Line::Control(call)); }, + &ClauseType::Sort => + code.push(sort_call!()), &ClauseType::Throw => code.push(Line::Control(ControlInstruction::ThrowCall)), _ => {} @@ -289,6 +293,10 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator *ctrl = ControlInstruction::NotEqExecute, ControlInstruction::CatchCall => *ctrl = ControlInstruction::CatchExecute, + ControlInstruction::KeySortCall => + *ctrl = ControlInstruction::KeySortExecute, + ControlInstruction::SortCall => + *ctrl = ControlInstruction::SortExecute, ControlInstruction::ThrowCall => *ctrl = ControlInstruction::ThrowExecute, ControlInstruction::IsCall(r, at) => diff --git a/src/prolog/io.rs b/src/prolog/io.rs index 912b605d..f9db8fc7 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -173,12 +173,20 @@ impl fmt::Display for ControlInstruction { write!(f, "jmp_by_call {}/{}", offset, arity), &ControlInstruction::JmpByExecute(arity, offset) => write!(f, "jmp_by_execute {}/{}", offset, arity), + &ControlInstruction::KeySortCall => + write!(f, "keysort_call"), + &ControlInstruction::KeySortExecute => + write!(f, "keysort_execute"), &ControlInstruction::NotEqCall => write!(f, "neq_call"), &ControlInstruction::NotEqExecute => write!(f, "neq_execute"), &ControlInstruction::Proceed => write!(f, "proceed"), + &ControlInstruction::SortCall => + write!(f, "call_sort"), + &ControlInstruction::SortExecute => + write!(f, "execute_sort"), &ControlInstruction::ThrowCall => write!(f, "call_throw"), &ControlInstruction::ThrowExecute => diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 39d1ad46..892d8911 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -91,8 +91,9 @@ impl MachineState { self.trail(r1); } - pub(super) fn print_term(&self, a: Addr, fmt: Fmt, output: Outputter) -> Outputter - where Fmt: HeapCellValueFormatter, Outputter: HeapCellValueOutputter + pub(super) fn print_term(&self, a: Addr, fmt: Fmt, output: Outputter) + -> Outputter + where Fmt: HeapCellValueFormatter, Outputter: HeapCellValueOutputter { let iter = HeapCellPreOrderIterator::new(&self, a); let printer = HeapCellPrinter::new(iter, fmt, output); @@ -939,7 +940,7 @@ impl MachineState { self.ball.0 = 0; self.ball.1.truncate(0); - + self.registers[1] = Addr::HeapCell(h); self.heap.append(hcv); @@ -1060,7 +1061,7 @@ impl MachineState { let a1 = self[temp_v!(1)].clone(); let a2 = self[temp_v!(2)].clone(); - match self.compare_term_test(a1, a2) { + match self.compare_term_test(&a1, &a2) { Ordering::Greater => match qt { CompareTermQT::GreaterThan | CompareTermQT::GreaterThanOrEqual => return, @@ -1079,8 +1080,8 @@ impl MachineState { }; } - fn compare_term_test(&self, a1: Addr, a2: Addr) -> Ordering { - let iter = self.zipped_acyclic_pre_order_iter(a1, a2); + fn compare_term_test(&self, a1: &Addr, a2: &Addr) -> Ordering { + let iter = self.zipped_acyclic_pre_order_iter(a1.clone(), a2.clone()); for (v1, v2) in iter { match (v1, v2) { @@ -1632,6 +1633,67 @@ impl MachineState { Ok(()) } + fn to_list>(&mut self, values: Iter) -> usize { + let head_addr = self.heap.h; + + for value in values { + let h = self.heap.h; + + self.heap.push(HeapCellValue::Addr(Addr::Lis(h+1))); + self.heap.push(HeapCellValue::Addr(value)); + } + + self.heap.push(HeapCellValue::Addr(Addr::Con(Constant::EmptyList))); + head_addr + } + + fn try_from_list(&self, r: RegType) -> Result, Vec> + { + let a1 = self.store(self.deref(self[r].clone())); + + match a1.clone() { + Addr::Lis(mut l) => { + let mut result = Vec::new(); + + result.push(self.heap[l].as_addr(l)); + l += 1; + + loop { + match self.heap[l].clone() { + HeapCellValue::Addr(Addr::Lis(hcp)) => { + result.push(self.heap[hcp].as_addr(hcp)); + l = hcp + 1; + }, + HeapCellValue::Addr(Addr::Con(Constant::EmptyList)) => + break, + hcv => + return Err(functor!("type_error", 2, [heap_atom!("list"), hcv])) + }; + } + + Ok(result) + }, + Addr::HeapCell(_) | Addr::StackCell(..) => + Err(functor!("instantiation_error")), + addr => + Err(functor!("type_error", 2, [heap_atom!("list"), HeapCellValue::Addr(addr)])) + } + } + + fn project_onto_key(&self, a: Addr) -> Result> { + match self.store(self.deref(a)) { + Addr::Str(s) => + match self.heap[s].clone() { + HeapCellValue::NamedStr(2, ref name, Some(Fixity::In)) + if *name == clause_name!("-") => + Ok(Addr::HeapCell(s+1)), + _ => + panic!("Addr::Str doesn't point to NamedStr.") + }, + a => Err(functor!("type_error", 2, [heap_atom!("callable"), HeapCellValue::Addr(a)])) + } + } + fn duplicate_term(&mut self) { let old_h = self.heap.h; @@ -1819,7 +1881,7 @@ impl MachineState { let a2 = self[temp_v!(2)].clone(); let a3 = self[temp_v!(3)].clone(); - let c = Addr::Con(match self.compare_term_test(a2, a3) { + let c = Addr::Con(match self.compare_term_test(&a2, &a3) { Ordering::Greater => atom!(">", self.atom_tbl), Ordering::Equal => atom!("=", self.atom_tbl), Ordering::Less => atom!("<", self.atom_tbl) @@ -1834,7 +1896,7 @@ impl MachineState { let a2 = self[temp_v!(2)].clone(); let a3 = self[temp_v!(3)].clone(); - let c = Addr::Con(match self.compare_term_test(a2, a3) { + let c = Addr::Con(match self.compare_term_test(&a2, &a3) { Ordering::Greater => atom!(">", self.atom_tbl), Ordering::Equal => atom!("=", self.atom_tbl), Ordering::Less => atom!("<", self.atom_tbl) @@ -2012,6 +2074,76 @@ impl MachineState { }, &ControlInstruction::Proceed => self.p = self.cp.clone(), + &ControlInstruction::SortCall => { + let mut list = try_or_fail!(self, { + let val = self.try_from_list(temp_v!(1)); + self.p += 1; + val + }); + + list.sort_unstable_by(|a1, a2| self.compare_term_test(a1, a2)); + let heap_addr = Addr::HeapCell(self.to_list(list.into_iter())); + + let r2 = self[temp_v!(2)].clone(); + self.unify(r2, heap_addr); + }, + &ControlInstruction::SortExecute => { + let mut list = try_or_fail!(self, { + let val = self.try_from_list(temp_v!(1)); + self.p = self.cp.clone(); + val + }); + + list.sort_unstable_by(|a1, a2| self.compare_term_test(a1, a2)); + let heap_addr = Addr::HeapCell(self.to_list(list.into_iter())); + + let r2 = self[temp_v!(2)].clone(); + self.unify(r2, heap_addr); + }, + &ControlInstruction::KeySortCall => { + let mut list = try_or_fail!(self, { + let val = self.try_from_list(temp_v!(1)); + self.p += 1; + val + }); + + let mut key_pairs = Vec::new(); + + for val in list { + let key = try_or_fail!(self, self.project_onto_key(val.clone())); + key_pairs.push((key, val.clone())); + } + + key_pairs.sort_unstable_by(|a1, a2| self.compare_term_test(&a1.0, &a2.0)); + + let key_pairs = key_pairs.into_iter().map(|kp| kp.1); + let heap_addr = Addr::HeapCell(self.to_list(key_pairs)); + + let r2 = self[temp_v!(2)].clone(); + self.unify(r2, heap_addr); + }, + &ControlInstruction::KeySortExecute => { + let mut list = try_or_fail!(self, { + let val = self.try_from_list(temp_v!(1)); + self.p = self.cp.clone(); + val + }); + + let mut key_pairs = Vec::new(); + + for val in list { + let key = try_or_fail!(self, self.project_onto_key(val.clone())); + key_pairs.push((key, val.clone())); + } + + key_pairs.sort_unstable_by(|a1, a2| self.compare_term_test(&a1.0, &a2.0)); + + let key_pairs = key_pairs.into_iter().map(|kp| kp.1); + let heap_addr = Addr::HeapCell(self.to_list(key_pairs)); + + let r2 = self[temp_v!(2)].clone(); + self.unify(r2, heap_addr); + }, &ControlInstruction::ThrowCall => { self.cp = self.p.clone() + 1; self.goto_throw(); diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index d78c7b76..83834000 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -707,3 +707,15 @@ macro_rules! try_eval_session { } ) } + +macro_rules! sort_call { + () => ( + Line::Control(ControlInstruction::SortCall) + ) +} + +macro_rules! keysort_call { + () => ( + Line::Control(ControlInstruction::KeySortCall) + ) +} diff --git a/src/prolog/parser b/src/prolog/parser index 54c9d939..a61db9f4 160000 --- a/src/prolog/parser +++ b/src/prolog/parser @@ -1 +1 @@ -Subproject commit 54c9d9394b4e17bac5ce7748a483a8b6c8cbb519 +Subproject commit a61db9f45e3c9c476944435e88abca0abe189cc2