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

switch to machine implemented arg

Browse Source
This commit is contained in:
Mark Thom
2018-05-13 14:55:44 -06:00
parent 175a5db5d7
commit 81d0538a5c
6 changed files with 101 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
src/prolog/ast.rs
View File

@@ -708,7 +708,6 @@ pub enum SystemClauseType {
RemoveInferenceCounter,
RestoreCutPolicy,
SetCutPoint(RegType),
GetArg,
InferenceLevel,
CleanUpBlock,
EraseBall,
@@ -740,7 +739,6 @@ impl SystemClauseType {
clause_name!("$remove_inference_counter"),
&SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"),
&SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"),
&SystemClauseType::GetArg => clause_name!("$get_arg"),
&SystemClauseType::InferenceLevel => clause_name!("$inference_level"),
&SystemClauseType::CleanUpBlock => clause_name!("$clean_up_block"),
&SystemClauseType::EraseBall => clause_name!("$erase_ball"),
@@ -769,7 +767,6 @@ impl SystemClauseType {
Some(SystemClauseType::RemoveInferenceCounter),
("$restore_cut_policy", 0) => Some(SystemClauseType::RestoreCutPolicy),
("$set_cp", 1) => Some(SystemClauseType::SetCutPoint(temp_v!(1))),
("$get_arg", 3) => Some(SystemClauseType::GetArg),
("$inference_level", 2) => Some(SystemClauseType::InferenceLevel),
("$clean_up_block", 1) => Some(SystemClauseType::CleanUpBlock),
("$erase_ball", 0) => Some(SystemClauseType::EraseBall),
@@ -790,6 +787,7 @@ impl SystemClauseType {
#[derive(Copy, Clone, PartialEq)]
pub enum BuiltInClauseType {
AcyclicTerm,
Arg,
Compare,
CompareTerm(CompareTermQT),
CyclicTerm,
@@ -892,6 +890,7 @@ impl BuiltInClauseType {
pub fn name(&self) -> ClauseName {
match self {
&BuiltInClauseType::AcyclicTerm => clause_name!("acyclic_term"),
&BuiltInClauseType::Arg => clause_name!("arg"),
&BuiltInClauseType::Compare => clause_name!("compare"),
&BuiltInClauseType::CompareTerm(qt) => clause_name!(qt.name()),
&BuiltInClauseType::CyclicTerm => clause_name!("cyclic_term"),
@@ -910,6 +909,7 @@ impl BuiltInClauseType {
pub fn arity(&self) -> usize {
match self {
&BuiltInClauseType::AcyclicTerm => 1,
&BuiltInClauseType::Arg => 3,
&BuiltInClauseType::Compare => 2,
&BuiltInClauseType::CompareTerm(_) => 2,
&BuiltInClauseType::CyclicTerm => 1,
@@ -928,6 +928,7 @@ impl BuiltInClauseType {
pub fn from(name: &str, arity: usize) -> Option<Self> {
match (name, arity) {
("acyclic_term", 1) => Some(BuiltInClauseType::AcyclicTerm),
("arg", 3) => Some(BuiltInClauseType::Arg),
("compare", 3) => Some(BuiltInClauseType::Compare),
("cyclic_term", 1) => Some(BuiltInClauseType::CyclicTerm),
("@>", 2) => Some(BuiltInClauseType::CompareTerm(CompareTermQT::GreaterThan)),

2
src/prolog/io.rs
View File

@@ -516,8 +516,6 @@ fn compile_decl(wam: &mut Machine, tl: TopLevel, queue: Vec<TopLevel>) -> EvalSe
decl_info.label_clauses(wam.code_size(), &mut wam.code_dir, &mut code);
print_code(&code);
if !code.is_empty() {
wam.add_user_code(name, tl.arity(), code, tl.as_predicate().ok().unwrap())
} else {

79
src/prolog/lib/builtins.pl
View File

@@ -4,7 +4,7 @@
(\/)/2, (is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2,
(>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2,
(-)/1, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (==)/2, (\==)/2,
(=..)/2, arg/3, catch/3, throw/1, true/0, false/0, length/2]).
catch/3, throw/1, true/0, false/0, length/2]).
% arithmetic operators.
:- op(700, xfx, is).
@@ -74,7 +74,48 @@ G1 -> G2 :- '$get_cp'(B), ->(G1, G2, B).
->(G1, G2, B) :- G2 == !, call(G1), !, '$set_cp'(B).
->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2).
% exception handling.
/*
Term =.. List :-
atomic(Term), !,
List = [Term].
Term =.. List :-
compound(Term), !,
( functor(Term, Name, NArgs) ->
List = [Name|Args], '$get_args'(Args, Term, 1, NArgs)
; Term = [_|_] ->
List = ['.'|Term] ).
Term =.. List :-
var(Term), !,
( List = [ATerm], atomic(ATerm) ->
Term = ATerm
; List = [Name|Args] ->
functor(Term, Name, Args)).
'$get_args'(Args, _, _, 0) :-
!, Args = [].
'$get_args'([Arg], Func, N, N) :-
!, '$get_arg'(N, Func, Arg).
'$get_args'([Arg|Args], Func, I0, N) :-
'$get_arg'(I0, Func, Arg), I1 is I0 + 1,
'$get_args'(Args, Func, I1, N).
*/
% arg.
/* The old, SWI Prolog-imitative arg/3.
arg(N, Functor, Arg) :- var(N), !, functor(Functor, _, Arity), arg_(N, 1, Arity, Functor, Arg).
arg(N, Functor, Arg) :- integer(N), !, functor(Functor, _, Arity), '$get_arg'(N, Functor, Arg).
arg(N, Functor, Arg) :- throw(error(type_error(integer, N), arg/3)).
arg_(N, N, N, Functor, Arg) :- !, '$get_arg'(N, Functor, Arg).
arg_(N, N, Arity, Functor, Arg) :- '$get_arg'(N, Functor, Arg).
arg_(N, N0, Arity, Functor, Arg) :- N0 < Arity, N1 is N0 + 1, arg_(N, N1, Arity, Functor, Arg).
*/
% The new, ISO Prolog compliant arg/3 is implemented in Rust.
% exceptions.
catch(G,C,R) :- '$get_current_block'(Bb), catch(G,C,R,Bb).
@@ -89,16 +130,6 @@ handle_ball(_, _, _) :- '$unwind_stack'.
throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'.
% arg.
arg(N, Functor, Arg) :- var(N), !, functor(Functor, _, Arity), arg_(N, 1, Arity, Functor, Arg).
arg(N, Functor, Arg) :- integer(N), !, functor(Functor, _, Arity), '$get_arg'(N, Functor, Arg).
arg(N, Functor, Arg) :- throw(error(type_error(integer, N), arg/3)).
arg_(N, N, N, Functor, Arg) :- !, '$get_arg'(N, Functor, Arg).
arg_(N, N, Arity, Functor, Arg) :- '$get_arg'(N, Functor, Arg).
arg_(N, N0, Arity, Functor, Arg) :- N0 < Arity, N1 is N0 + 1, arg_(N, N1, Arity, Functor, Arg).
% length.
length(Xs, N) :-
@@ -127,27 +158,3 @@ length(_, N) :-
'$length_rundown'([_|Xs], N) :-
N1 is N-1,
'$length_rundown'(Xs, N1).
Term =.. List :-
atomic(Term), !,
List = [Term].
Term =.. List :-
compound(Term), !,
( functor(Term, Name, NArgs) ->
List = [Name|Args], '$get_args'(Args, Term, 1, NArgs)
; Term = [_|_] ->
List = ['.'|Term] ).
Term =.. List :-
var(Term), !,
( List = [ATerm], atomic(ATerm) ->
Term = ATerm
; List = [Name|Args] ->
functor(Term, Name, Args)).
'$get_args'(Args, _, _, 0) :-
!, Args = [].
'$get_args'([Arg], Func, N, N) :-
!, '$get_arg'(N, Func, Arg).
'$get_args'([Arg|Args], Func, I0, N) :-
'$get_arg'(I0, Func, Arg), I1 is I0 + 1,
'$get_args'(Args, Func, I1, N).

4
src/prolog/machine/machine_state.rs
View File

@@ -410,6 +410,10 @@ pub(crate) trait CallPolicy: Any {
machine_st.fail = machine_st.is_cyclic_term(addr);
return_from_clause!(machine_st.last_call, machine_st)
},
&BuiltInClauseType::Arg => {
machine_st.try_arg()?;
return_from_clause!(machine_st.last_call, machine_st)
},
&BuiltInClauseType::Compare => {
let a1 = machine_st[temp_v!(1)].clone();
let a2 = machine_st[temp_v!(2)].clone();

69
src/prolog/machine/machine_state_impl.rs
View File

@@ -5,7 +5,7 @@ use prolog::heap_iter::*;
use prolog::heap_print::*;
use prolog::machine::machine_errors::*;
use prolog::machine::machine_state::*;
use prolog::num::{Integer, ToPrimitive, Zero};
use prolog::num::{Integer, Signed, ToPrimitive, Zero};
use prolog::num::bigint::{BigInt, BigUint};
use prolog::num::rational::Ratio;
use prolog::or_stack::*;
@@ -1166,31 +1166,62 @@ impl MachineState {
fail
}
pub(super) fn try_get_arg(&mut self) -> CallResult
// arg(+N, +Term, ?Arg)
pub(super) fn try_arg(&mut self) -> CallResult
{
let a1 = self.store(self.deref(self[temp_v!(1)].clone()));
let stub = self.functor_stub(clause_name!("arg"), 3);
let n = self.store(self.deref(self[temp_v!(1)].clone()));
if let Addr::Con(Constant::Number(Number::Integer(i))) = a1 {
let a2 = self.store(self.deref(self[temp_v!(2)].clone()));
match n {
Addr::HeapCell(_) | Addr::StackCell(..) => // 8.5.2.3 a)
return Err(self.error_form(self.instantiation_error(), stub)),
Addr::Con(Constant::Number(Number::Integer(n))) => {
if n.is_negative() {
// 8.5.2.3 e)
let n = Addr::Con(Constant::Number(Number::Integer(n)));
return Err(self.error_form(self.domain_error(DomainError::NotLessThanZero,
n),
stub));
}
let n = match n.to_usize() {
Some(n) => n,
None => {
self.fail = true;
return Ok(());
}
};
if let Addr::Str(o) = a2 {
match self.heap[o].clone() {
HeapCellValue::NamedStr(arity, _, _) =>
match i.to_usize() {
Some(i) if 1 <= i && i <= arity => {
let term = self.store(self.deref(self[temp_v!(2)].clone()));
match term {
Addr::HeapCell(_) | Addr::StackCell(..) => // 8.5.2.3 b)
return Err(self.error_form(self.instantiation_error(), stub)),
Addr::Str(o) =>
match self.heap[o].clone() {
HeapCellValue::NamedStr(arity, _, _) if 1 <= n && n <= arity => {
let a3 = self[temp_v!(3)].clone();
let h_a = Addr::HeapCell(o + i);
let h_a = Addr::HeapCell(o + n);
self.unify(a3, h_a);
},
_ => self.fail = true
},
_ => self.fail = true
};
} else {
let stub = self.functor_stub(clause_name!("arg"), 3);
return Err(self.error_form(self.type_error(ValidType::Compound, a2), stub));
}
Addr::Lis(l) if n == 1 || n == 2 => {
let a3 = self[temp_v!(3)].clone();
let h_a = Addr::HeapCell(l + n - 1);
self.unify(a3, h_a);
},
_ => // 8.5.2.3 d)
return Err(self.error_form(self.type_error(ValidType::Compound, term),
stub))
}
},
_ => // 8.5.2.3 c)
return Err(self.error_form(self.type_error(ValidType::Integer, n), stub))
}
Ok(())
@@ -1447,7 +1478,7 @@ impl MachineState {
self.try_functor_unify_components(name, arity);
}
pub(super) fn try_functor(&mut self) -> Result<(), MachineError> {
pub(super) fn try_functor(&mut self) -> CallResult {
let stub = self.functor_stub(clause_name!("functor"), 3);
let a1 = self.store(self.deref(self[temp_v!(1)].clone()));

2
src/prolog/machine/system_calls.rs
View File

@@ -254,8 +254,6 @@ impl MachineState {
},
&SystemClauseType::SetCutPoint(r) =>
cut_policy.cut(self, r),
&SystemClauseType::GetArg =>
return self.try_get_arg(),
&SystemClauseType::InferenceLevel => {
let a1 = self[temp_v!(1)].clone();
let a2 = self.store(self.deref(self[temp_v!(2)].clone()));