parse the list functor

This commit is contained in:
Mark Thom
2018-05-13 14:10:48 -06:00
parent b0bdf50a78
commit 175a5db5d7
7 changed files with 140 additions and 68 deletions

View File

@@ -22,6 +22,8 @@ pub type Var = String;
pub type Specifier = u32; pub type Specifier = u32;
pub const MAX_ARITY: usize = 63;
pub const XFX: u32 = 0x0001; pub const XFX: u32 = 0x0001;
pub const XFY: u32 = 0x0002; pub const XFY: u32 = 0x0002;
pub const YFX: u32 = 0x0004; pub const YFX: u32 = 0x0004;

View File

@@ -3,8 +3,8 @@
:- module(builtins, [(=)/2, (+)/2, (*)/2, (-)/2, (/)/2, (/\)/2, :- module(builtins, [(=)/2, (+)/2, (*)/2, (-)/2, (/)/2, (/\)/2,
(\/)/2, (is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2, (\/)/2, (is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2,
(>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2,
(-)/1, (>=)/2, (=<)/2, (->)/2, (;)/2, (==)/2, (\==)/2, arg/3, (-)/1, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (==)/2, (\==)/2,
catch/3, throw/1, true/0, false/0, length/2]). (=..)/2, arg/3, catch/3, throw/1, true/0, false/0, length/2]).
% arithmetic operators. % arithmetic operators.
:- op(700, xfx, is). :- op(700, xfx, is).
@@ -33,6 +33,7 @@
% unify. % unify.
:- op(700, xfx, =). :- op(700, xfx, =).
:- op(700, xfx, =..).
% conditional operators. % conditional operators.
:- op(1050, xfy, ->). :- op(1050, xfy, ->).
@@ -105,14 +106,12 @@ length(Xs, N) :-
'$skip_max_list'(M, -1, Xs, Xs0), '$skip_max_list'(M, -1, Xs, Xs0),
( Xs0 == [] -> N = M ( Xs0 == [] -> N = M
; var(Xs0) -> '$length_addendum'(Xs0, N, M)). ; var(Xs0) -> '$length_addendum'(Xs0, N, M)).
% ; throw(error(type_error(list, Xs), length/2))).
length(Xs, N) :- length(Xs, N) :-
integer(N), integer(N),
N >= 0, !, N >= 0, !,
'$skip_max_list'(M, N, Xs, Xs0), '$skip_max_list'(M, N, Xs, Xs0),
( Xs0 == [] -> N = M ( Xs0 == [] -> N = M
; var(Xs0) -> R is N-M, '$length_rundown'(Xs0, R)). ; var(Xs0) -> R is N-M, '$length_rundown'(Xs0, R)).
% ; throw(error(type_error(list, Xs), length/2))).
length(_, N) :- length(_, N) :-
integer(N), !, integer(N), !,
throw(error(domain_error(not_less_than_zero, N), length/2)). throw(error(domain_error(not_less_than_zero, N), length/2)).
@@ -128,3 +127,27 @@ length(_, N) :-
'$length_rundown'([_|Xs], N) :- '$length_rundown'([_|Xs], N) :-
N1 is N-1, N1 is N-1,
'$length_rundown'(Xs, N1). '$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).

View File

@@ -10,8 +10,8 @@ pub(super) type MachineStub = Vec<HeapCellValue>;
// from 7.12.2 b) of 13211-1:1995 // from 7.12.2 b) of 13211-1:1995
#[derive(Clone, Copy)] #[derive(Clone, Copy)]
pub enum ValidType { pub enum ValidType {
// Atom, Atom,
// Atomic, Atomic,
// Byte, // Byte,
Callable, Callable,
// Character, // Character,
@@ -30,8 +30,8 @@ pub enum ValidType {
impl ValidType { impl ValidType {
pub fn as_str(self) -> &'static str { pub fn as_str(self) -> &'static str {
match self { match self {
// ValidType::Atom => "atom", ValidType::Atom => "atom",
// ValidType::Atomic => "atomic", ValidType::Atomic => "atomic",
// ValidType::Byte => "byte", // ValidType::Byte => "byte",
ValidType::Callable => "callable", ValidType::Callable => "callable",
// ValidType::Character => "character", // ValidType::Character => "character",
@@ -49,6 +49,19 @@ impl ValidType {
} }
} }
#[derive(Clone, Copy)]
pub enum DomainError {
NotLessThanZero
}
impl DomainError {
pub fn as_str(self) -> &'static str {
match self {
DomainError::NotLessThanZero => "not_less_than_zero"
}
}
}
// from 7.12.2 f) of 13211-1:1995 // from 7.12.2 f) of 13211-1:1995
#[derive(Clone, Copy)] #[derive(Clone, Copy)]
pub enum RepFlag { pub enum RepFlag {
@@ -198,6 +211,10 @@ impl MachineState {
error error
} }
pub(super) fn domain_error(&self, error: DomainError, culprit: Addr) -> MachineError {
functor!("domain_error", 2, [heap_atom!(error.as_str()), HeapCellValue::Addr(culprit)])
}
pub(super) fn instantiation_error(&self) -> MachineError { pub(super) fn instantiation_error(&self) -> MachineError {
functor!("instantiation_error") functor!("instantiation_error")
} }

View File

@@ -43,7 +43,7 @@ impl MachineState {
mode: MachineMode::Write, mode: MachineMode::Write,
and_stack: AndStack::new(), and_stack: AndStack::new(),
or_stack: OrStack::new(), or_stack: OrStack::new(),
registers: vec![Addr::HeapCell(0); 64], registers: vec![Addr::HeapCell(0); MAX_ARITY + 1], // self.registers[0] is never used.
trail: Vec::new(), trail: Vec::new(),
tr: 0, tr: 0,
hb: 0, hb: 0,
@@ -168,6 +168,21 @@ impl MachineState {
self.bind(Ref::StackCell(fr, sc), d2), self.bind(Ref::StackCell(fr, sc), d2),
(_, Addr::StackCell(fr, sc)) => (_, Addr::StackCell(fr, sc)) =>
self.bind(Ref::StackCell(fr, sc), d1), self.bind(Ref::StackCell(fr, sc), d1),
(Addr::Lis(a1), Addr::Str(a2)) | (Addr::Str(a2), Addr::Lis(a1)) => {
if let &HeapCellValue::NamedStr(n2, ref f2, _) = &self.heap[a2] {
if f2.as_str() == "." && n2 == 2 {
pdl.push(Addr::HeapCell(a1));
pdl.push(Addr::HeapCell(a2 + 1));
pdl.push(Addr::HeapCell(a1 + 1));
pdl.push(Addr::HeapCell(a2 + 2));
continue;
}
}
self.fail = true;
},
(Addr::Lis(a1), Addr::Lis(a2)) => { (Addr::Lis(a1), Addr::Lis(a2)) => {
pdl.push(Addr::HeapCell(a1)); pdl.push(Addr::HeapCell(a1));
pdl.push(Addr::HeapCell(a2)); pdl.push(Addr::HeapCell(a2));
@@ -175,10 +190,9 @@ impl MachineState {
pdl.push(Addr::HeapCell(a1 + 1)); pdl.push(Addr::HeapCell(a1 + 1));
pdl.push(Addr::HeapCell(a2 + 1)); pdl.push(Addr::HeapCell(a2 + 1));
}, },
(Addr::Con(c1), Addr::Con(c2)) => { (Addr::Con(c1), Addr::Con(c2)) =>
if c1 != c2 { if c1 != c2 {
self.fail = true; self.fail = true;
}
}, },
(Addr::Str(a1), Addr::Str(a2)) => { (Addr::Str(a1), Addr::Str(a2)) => {
let r1 = &self.heap[a1]; let r1 = &self.heap[a1];
@@ -1415,35 +1429,49 @@ impl MachineState {
} }
} }
fn try_functor_unify_components(&mut self, name: Addr, arity: Addr) {
let a2 = self[temp_v!(2)].clone();
let a3 = self[temp_v!(3)].clone();
self.unify(a2, name);
if !self.fail {
self.unify(a3, arity);
}
}
fn try_functor_compound_case(&mut self, name: ClauseName, arity: usize) {
let name = Addr::Con(Constant::Atom(name));
let arity = Addr::Con(integer!(arity));
self.try_functor_unify_components(name, arity);
}
pub(super) fn try_functor(&mut self) -> Result<(), MachineError> { pub(super) fn try_functor(&mut self) -> Result<(), MachineError> {
let stub = self.functor_stub(clause_name!("functor"), 3); let stub = self.functor_stub(clause_name!("functor"), 3);
let a1 = self.store(self.deref(self[temp_v!(1)].clone())); let a1 = self.store(self.deref(self[temp_v!(1)].clone()));
match a1.clone() { match a1.clone() {
Addr::Con(_) =>
self.try_functor_unify_components(a1, Addr::Con(integer!(0))),
Addr::Str(o) => Addr::Str(o) =>
match self.heap[o].clone() { match self.heap[o].clone() {
HeapCellValue::NamedStr(arity, name, _) => { HeapCellValue::NamedStr(arity, name, _) =>
let name = Addr::Con(Constant::Atom(name)); // A2 self.try_functor_compound_case(name, arity),
let arity = Addr::Con(Constant::Number(rc_integer!(arity)));
let a2 = self[temp_v!(2)].clone();
self.unify(a2, name);
if !self.fail {
let a3 = self[temp_v!(3)].clone();
self.unify(a3, arity);
}
},
_ => self.fail = true _ => self.fail = true
}, },
Addr::Lis(_) =>
self.try_functor_compound_case(clause_name!("."), 2),
Addr::HeapCell(_) | Addr::StackCell(_, _) => { Addr::HeapCell(_) | Addr::StackCell(_, _) => {
let name = self.store(self.deref(self[temp_v!(2)].clone())); let name = self.store(self.deref(self[temp_v!(2)].clone()));
let arity = self.store(self.deref(self[temp_v!(3)].clone())); let arity = self.store(self.deref(self[temp_v!(3)].clone()));
if let Addr::Con(Constant::Atom(name)) = name { if name.is_ref() || arity.is_ref() { // 8.5.1.3 a) & 8.5.1.3 b)
return Err(self.error_form(self.instantiation_error(), stub));
}
if let Addr::Con(Constant::Number(Number::Integer(arity))) = arity { if let Addr::Con(Constant::Number(Number::Integer(arity))) = arity {
let f_a = Addr::Str(self.heap.h); let arity = match arity.to_isize() {
let arity = match arity.to_usize() {
Some(arity) => arity, Some(arity) => arity,
None => { None => {
self.fail = true; self.fail = true;
@@ -1451,33 +1479,41 @@ impl MachineState {
} }
}; };
if arity > 0 { if arity > MAX_ARITY as isize {
self.heap.push(HeapCellValue::NamedStr(arity, name, None)); // 8.5.1.3 f)
} else { return Err(self.error_form(self.representation_error(RepFlag::MaxArity),
let c = Constant::Atom(name.clone()); stub));
self.heap.push(HeapCellValue::Addr(Addr::Con(c))); } else if arity < 0 {
// 8.5.1.3 g)
return Err(self.error_form(self.domain_error(DomainError::NotLessThanZero,
Addr::Con(integer!(arity))),
stub));
} }
match name {
Addr::Con(_) if arity == 0 =>
self.unify(a1, name),
Addr::Con(Constant::Atom(name)) => {
let f_a = Addr::Str(self.heap.h);
self.heap.push(HeapCellValue::NamedStr(arity as usize, name, None));
for _ in 0 .. arity { for _ in 0 .. arity {
let h = self.heap.h; let h = self.heap.h;
self.heap.push(HeapCellValue::Addr(Addr::HeapCell(h))); self.heap.push(HeapCellValue::Addr(Addr::HeapCell(h)));
} }
self.unify(a1, f_a); self.unify(a1, f_a);
} else {
return Err(self.error_form(self.instantiation_error(), stub));
}
} else {
return Err(self.error_form(self.instantiation_error(), stub));
}
}, },
_ => { Addr::Con(_) =>
let a2 = self[temp_v!(2)].clone(); return Err(self.error_form(self.type_error(ValidType::Atom, name),
self.unify(a1, a2); stub)), // 8.5.1.3 e)
_ =>
if !self.fail { return Err(self.error_form(self.type_error(ValidType::Atomic, name),
let a3 = self[temp_v!(3)].clone(); stub)) // 8.5.1.3 c)
self.unify(a3, Addr::Con(Constant::Number(rc_integer!(0)))); };
} else if !arity.is_ref() {
// 8.5.1.3 d)
return Err(self.error_form(self.type_error(ValidType::Integer, arity), stub));
} }
} }
}; };

View File

@@ -164,12 +164,6 @@ macro_rules! integer {
) )
} }
macro_rules! rc_integer {
($e:expr) => (
Number::Integer(Rc::new(BigInt::from($e)))
)
}
macro_rules! rc_atom { macro_rules! rc_atom {
($e:expr) => ( ($e:expr) => (
Rc::new(String::from($e)) Rc::new(String::from($e))

View File

@@ -1381,7 +1381,7 @@ fn test_queries_on_builtins()
assert_prolog_success!(&mut wam, "?- length(Xs, 0).", [["Xs = []"]]); assert_prolog_success!(&mut wam, "?- length(Xs, 0).", [["Xs = []"]]);
assert_prolog_success!(&mut wam, "?- length([a,b,[a,b,c]], 3)."); assert_prolog_success!(&mut wam, "?- length([a,b,[a,b,c]], 3).");
assert_prolog_failure!(&mut wam, "?- length([a,b,[a,b,c]], 2)."); assert_prolog_failure!(&mut wam, "?- length([a,b,[a,b,c]], 2).");
assert_prolog_success!(&mut wam, "?- catch(length(a, []), type_error(_, E), true).", assert_prolog_success!(&mut wam, "?- catch(length(a, []), type_error(integer, E), true).",
[["E = []"]]); [["E = []"]]);
assert_prolog_success!(&mut wam, "?- duplicate_term([1,2,3], [X,Y,Z]).", assert_prolog_success!(&mut wam, "?- duplicate_term([1,2,3], [X,Y,Z]).",