]> Repositorios git - scryer-prolog.git/commitdiff
add sort, keysort.
authorMark Thom <[email protected]>
Sun, 11 Mar 2018 23:37:29 +0000 (17:37 -0600)
committerMark Thom <[email protected]>
Sun, 11 Mar 2018 23:37:29 +0000 (17:37 -0600)
README.md
src/prolog/ast.rs
src/prolog/codegen.rs
src/prolog/io.rs
src/prolog/machine/machine_state_impl.rs
src/prolog/macros.rs
src/prolog/parser

index 7dfb1378c7f8bd56da400c5e5f4d4602ad7bdc98..0b1b996f24848b92d2937f85e07aa63166e8e715 100644 (file)
--- 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`
index 2ab59feb7b285e46618b8a6f140927f823175938..e090828ef3898c5eef33baf8f2d2de880562a344 100644 (file)
@@ -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)
         }
     }
index b770a693478bcc623e27af9dc69186e55ce69480..3ca845d8628f3f9828f44adf8cf758942c20448e 100644 (file)
@@ -240,12 +240,16 @@ impl<'a, TermMarker: Allocator<'a>> CodeGenerator<TermMarker>
                         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<TermMarker>
                         *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) =>
index 912b605dd61d19569ed921a903689cc6868ef644..f9db8fc7c6ef0eca8f5117028e7f5766ff3f9cf3 100644 (file)
@@ -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 =>
index 39d1ad463a67d572063487231c6e4725e273c9e7..892d8911110116badaa6ea890c03ef8ed42395f4 100644 (file)
@@ -91,8 +91,9 @@ impl MachineState {
         self.trail(r1);
     }
 
-    pub(super) fn print_term<Fmt, Outputter>(&self, a: Addr, fmt: Fmt, output: Outputter) -> Outputter
-        where Fmt: HeapCellValueFormatter, Outputter: HeapCellValueOutputter
+    pub(super) fn print_term<Fmt, Outputter>(&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<Iter: Iterator<Item=Addr>>(&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<Addr>, Vec<HeapCellValue>>
+    {
+        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<Addr, Vec<HeapCellValue>> {
+        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();
index d78c7b76a8feba797626b6877512a6a907d32553..838340004e2ffb0762a09cdc6c96304463dcb590 100644 (file)
@@ -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)
+    )
+}
index 54c9d9394b4e17bac5ce7748a483a8b6c8cbb519..a61db9f45e3c9c476944435e88abca0abe189cc2 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 54c9d9394b4e17bac5ce7748a483a8b6c8cbb519
+Subproject commit a61db9f45e3c9c476944435e88abca0abe189cc2