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

add sort, keysort.

Browse Source
This commit is contained in:
Mark Thom
2018-03-11 17:37:29 -06:00
parent 7500465b38
commit acdb3f2c45
7 changed files with 204 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

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

52
src/prolog/ast.rs
View 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)
}
}

8
src/prolog/codegen.rs
View 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) =>

8
src/prolog/io.rs
View 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 =>

148
src/prolog/machine/machine_state_impl.rs
View 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();

12
src/prolog/macros.rs
View 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)
)
}

2
src/prolog/parser

Submodule src/prolog/parser updated: 54c9d9394b...a61db9f45e