pub type Specifier = u32;
+pub const MAX_ARITY: usize = 63;
+
pub const XFX: u32 = 0x0001;
pub const XFY: u32 = 0x0002;
pub const YFX: u32 = 0x0004;
:- module(builtins, [(=)/2, (+)/2, (*)/2, (-)/2, (/)/2, (/\)/2,
(\/)/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, arg/3,
- catch/3, throw/1, true/0, false/0, length/2]).
+ (-)/1, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (==)/2, (\==)/2,
+ (=..)/2, arg/3, catch/3, throw/1, true/0, false/0, length/2]).
% arithmetic operators.
:- op(700, xfx, is).
% unify.
:- op(700, xfx, =).
+:- op(700, xfx, =..).
% conditional operators.
:- op(1050, xfy, ->).
'$skip_max_list'(M, -1, Xs, Xs0),
( Xs0 == [] -> N = M
; var(Xs0) -> '$length_addendum'(Xs0, N, M)).
- % ; throw(error(type_error(list, Xs), length/2))).
length(Xs, N) :-
integer(N),
N >= 0, !,
'$skip_max_list'(M, N, Xs, Xs0),
( Xs0 == [] -> N = M
; var(Xs0) -> R is N-M, '$length_rundown'(Xs0, R)).
- % ; throw(error(type_error(list, Xs), length/2))).
length(_, N) :-
integer(N), !,
throw(error(domain_error(not_less_than_zero, N), length/2)).
'$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).
// from 7.12.2 b) of 13211-1:1995
#[derive(Clone, Copy)]
pub enum ValidType {
-// Atom,
-// Atomic,
+ Atom,
+ Atomic,
// Byte,
Callable,
// Character,
impl ValidType {
pub fn as_str(self) -> &'static str {
match self {
-// ValidType::Atom => "atom",
-// ValidType::Atomic => "atomic",
+ ValidType::Atom => "atom",
+ ValidType::Atomic => "atomic",
// ValidType::Byte => "byte",
ValidType::Callable => "callable",
// ValidType::Character => "character",
}
}
+#[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
#[derive(Clone, Copy)]
pub enum RepFlag {
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 {
functor!("instantiation_error")
}
mode: MachineMode::Write,
and_stack: AndStack::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(),
tr: 0,
hb: 0,
},
None => {}
}
- }
+ }
}
pub(super)
self.bind(Ref::StackCell(fr, sc), d2),
(_, Addr::StackCell(fr, sc)) =>
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)) => {
pdl.push(Addr::HeapCell(a1));
pdl.push(Addr::HeapCell(a2));
pdl.push(Addr::HeapCell(a1 + 1));
pdl.push(Addr::HeapCell(a2 + 1));
},
- (Addr::Con(c1), Addr::Con(c2)) => {
+ (Addr::Con(c1), Addr::Con(c2)) =>
if c1 != c2 {
self.fail = true;
- }
- },
+ },
(Addr::Str(a1), Addr::Str(a2)) => {
let r1 = &self.heap[a1];
let r2 = &self.heap[a2];
}
}
+ 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> {
let stub = self.functor_stub(clause_name!("functor"), 3);
let a1 = self.store(self.deref(self[temp_v!(1)].clone()));
match a1.clone() {
+ Addr::Con(_) =>
+ self.try_functor_unify_components(a1, Addr::Con(integer!(0))),
Addr::Str(o) =>
match self.heap[o].clone() {
- HeapCellValue::NamedStr(arity, name, _) => {
- let name = Addr::Con(Constant::Atom(name)); // A2
- 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);
- }
- },
+ HeapCellValue::NamedStr(arity, name, _) =>
+ self.try_functor_compound_case(name, arity),
_ => self.fail = true
},
+ Addr::Lis(_) =>
+ self.try_functor_compound_case(clause_name!("."), 2),
Addr::HeapCell(_) | Addr::StackCell(_, _) => {
let name = self.store(self.deref(self[temp_v!(2)].clone()));
let arity = self.store(self.deref(self[temp_v!(3)].clone()));
- if let Addr::Con(Constant::Atom(name)) = name {
- if let Addr::Con(Constant::Number(Number::Integer(arity))) = arity {
- let f_a = Addr::Str(self.heap.h);
- let arity = match arity.to_usize() {
- Some(arity) => arity,
- None => {
- self.fail = true;
- return Ok(());
- }
- };
-
- if arity > 0 {
- self.heap.push(HeapCellValue::NamedStr(arity, name, None));
- } else {
- let c = Constant::Atom(name.clone());
- self.heap.push(HeapCellValue::Addr(Addr::Con(c)));
- }
+ 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));
+ }
- for _ in 0 .. arity {
- let h = self.heap.h;
- self.heap.push(HeapCellValue::Addr(Addr::HeapCell(h)));
+ if let Addr::Con(Constant::Number(Number::Integer(arity))) = arity {
+ let arity = match arity.to_isize() {
+ Some(arity) => arity,
+ None => {
+ self.fail = true;
+ return Ok(());
}
+ };
- self.unify(a1, f_a);
- } else {
- return Err(self.error_form(self.instantiation_error(), stub));
+ if arity > MAX_ARITY as isize {
+ // 8.5.1.3 f)
+ return Err(self.error_form(self.representation_error(RepFlag::MaxArity),
+ stub));
+ } else if arity < 0 {
+ // 8.5.1.3 g)
+ return Err(self.error_form(self.domain_error(DomainError::NotLessThanZero,
+ Addr::Con(integer!(arity))),
+ stub));
}
- } else {
- return Err(self.error_form(self.instantiation_error(), stub));
- }
- },
- _ => {
- let a2 = self[temp_v!(2)].clone();
- self.unify(a1, a2);
- if !self.fail {
- let a3 = self[temp_v!(3)].clone();
- self.unify(a3, Addr::Con(Constant::Number(rc_integer!(0))));
+ 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 {
+ let h = self.heap.h;
+ self.heap.push(HeapCellValue::Addr(Addr::HeapCell(h)));
+ }
+
+ self.unify(a1, f_a);
+ },
+ Addr::Con(_) =>
+ return Err(self.error_form(self.type_error(ValidType::Atom, name),
+ stub)), // 8.5.1.3 e)
+ _ =>
+ return Err(self.error_form(self.type_error(ValidType::Atomic, name),
+ stub)) // 8.5.1.3 c)
+ };
+ } else if !arity.is_ref() {
+ // 8.5.1.3 d)
+ return Err(self.error_form(self.type_error(ValidType::Integer, arity), stub));
}
}
};
)
}
-macro_rules! rc_integer {
- ($e:expr) => (
- Number::Integer(Rc::new(BigInt::from($e)))
- )
-}
-
macro_rules! rc_atom {
($e:expr) => (
Rc::new(String::from($e))
-Subproject commit 7f9094eaedf235ffacb7c49f098593f22957fcfc
+Subproject commit ae747778688290ecf1c80b68cf34cf28bffac9f8
assert_prolog_success!(&mut wam, "?- length(Xs, 0).", [["Xs = []"]]);
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_success!(&mut wam, "?- catch(length(a, []), type_error(_, E), true).",
+ assert_prolog_success!(&mut wam, "?- catch(length(a, []), type_error(integer, E), true).",
[["E = []"]]);
assert_prolog_success!(&mut wam, "?- duplicate_term([1,2,3], [X,Y,Z]).",
projects / scryer-prolog.git / commitdiff